#' @include zzz.R
#' @include helpers.R
NULL

#' Server function for the mapping app
#'
#' @param input,output,session Required Shiny app server parameters
#'
#' @return The shiny server logic
#'
#' @importFrom BiocGenerics width
#' @importFrom BSgenome.Hsapiens.UCSC.hg38 BSgenome.Hsapiens.UCSC.hg38
#' @importFrom data.table as.data.table
#' @importFrom DT dataTableProxy renderDT selectRows
#' @importFrom EnsDb.Hsapiens.v86 EnsDb.Hsapiens.v86
#' @importFrom future future plan resolved value
#' @importFrom GenomeInfoDb seqlevelsStyle seqnames standardChromosomes
#' @importFrom GenomicRanges granges makeGRangesFromDataFrame
#' @importFrom ggplot2 annotate geom_hline ggtitle scale_colour_hue
#' theme_void xlab layer_scales xlim ylim ggplot aes geom_point theme
#' element_blank element_rect labs
#' @importFrom googlesheets4 gs4_auth gs4_get sheet_append
#' @importFrom IRanges findOverlaps
#' @importFrom Matrix sparse.model.matrix
#' @importFrom JASPAR2020 JASPAR2020
#' @importFrom methods slot slot<- new
#' @importFrom presto wilcoxauc
#' @importFrom SeuratObject AddMetaData Assays Cells DefaultAssay Embeddings
#' GetAssayData Idents Idents<- Key RenameCells Reductions Tool SetAssayData
#' VariableFeatures
#' @importFrom Seurat CreateAssayObject GetAssayData DimPlot FeaturePlot FindNeighbors FindTransferAnchors
#' IntegrateEmbeddings MappingScore NoLegend PercentageFeatureSet
#' RunUMAP TransferData SCTransform VlnPlot LabelClusters
#' FindBridgeTransferAnchors MapQuery NormalizeData
#' @importFrom Signac AddMotifs Annotation CreateChromatinAssay Extend FindMotifs FindTopFeatures GRangesToString 
#' GetGRangesFromEnsDb RunChromVAR RunSVD RunTFIDF AddMotifs
#' @importFrom shiny downloadHandler observeEvent isolate Progress
#' reactiveValues renderPlot renderTable renderText removeUI setProgress
#' safeError updateNumericInput updateSelectizeInput updateCheckboxInput updateTextAreaInput
#' withProgress renderUI onStop showNotification wellPanel nearPoints insertUI
#' modalDialog showModal getDefaultReactiveDomain
#' @importFrom shinydashboard menuItem renderMenu renderValueBox
#' sidebarMenu valueBox
#' @importFrom shinyjs addClass enable disable hide removeClass show onclick
#' disable
#' @importFrom stringr str_interp str_trim str_split
#' @importFrom patchwork wrap_plots
#' @importFrom stats na.omit quantile setNames median
#' @importFrom TFBSTools getMatrixSet
#' @importFrom S4Vectors queryHits subjectHits
#' @importFrom utils write.table packageVersion
#' @importFrom plotly plotlyOutput renderPlotly toWebGL ggplotly plot_ly
#' 
#' @keywords internal
#'
AzimuthServer <- function(input, output, session) {
  hide(id = "legend")
  disable(id = 'metacolor.ref')
  # hide demo dataset button if required
  if (is.null(x = getOption(x = 'Azimuth.app.demodataset'))) {
    hide(id = "demobuttons")
  }
  do.adt <- isTRUE(x = as.logical(getOption(x = 'Azimuth.app.do_adt'), default = TRUE))
  adt.key <- 'impADT'
  # Do Bridge Integration Workflow for ATAC query
  do.bridge <- isTRUE(x = as.logical(getOption(x = 'Azimuth.app.do_bridge'), default = FALSE))
  mt.key <- 'percent.mt'
  mito.pattern <- getOption(x = 'Azimuth.app.mito', default = '^MT-')
  
  n.trees <- getOption(x = "Azimuth.map.ntrees")
  app.env <- reactiveValues(
    adt.features = character(length = 0L),
    anchors = NULL,
    annotations = NULL,
    bridge = FALSE,
    bridge_anchors = FALSE,
    chromatin_assay_1 = NULL,
    chromatin_assay_2 = NULL,
    motif.diff.expr = list(),
    motif.feature = "", 
    motif.features = character(length = 0L),
    clusterpreservationqc = NULL,
    counts = FALSE,
    demo = FALSE,
    demo.inputs = NULL,
    demo.tracker = NULL,
    demo.files = NULL,
    default.assay = NULL,
    default.motif.feature = NULL,
    default.feature = NULL,
    default.metadata = NULL,
    diff.exp = list(),
    feature = '',
    features = character(length = 0L),
    mapping.score = NULL,
    messages = 'Upload a file',
    nanchors = 0L,
    ncellsupload = 0L,
    ncellspreproc = 0L,
    object = NULL,
    metadata.cont = character(length = 0L),
    scorefeatures = character(length = 0L),
    plot.ranges = list(),
    plots.refdim_df = NULL,
    plots.refdim_intro_df = NULL,
    plots.objdim_df = NULL,
    plots.querydim_df = NULL,
    fresh.plot = TRUE,
    singlepred = NULL,
    emptyref = NULL,
    merged = NULL,
    metadata.discrete = NULL,
    metadata.notransfer = NULL,
    requantified_multiome = NULL, 
    requantified_genes = NULL,
    disable = FALSE,
    query.names = character()
  )
  react.env <- reactiveValues(
    no = FALSE,
    anchors = FALSE,
    annotations = FALSE,
    biomarkers = FALSE,
    bridge = FALSE,
    bridge.query = FALSE,
    bridge_anchors = FALSE,
    motif = FALSE, 
    motif.features = FALSE,
    chromatin_assay_1 = FALSE,
    cluster.score = FALSE,
    features = FALSE,
    get.motif.feature = FALSE,
    get.feature = FALSE,
    map = FALSE,
    markers = FALSE,
    metadata = FALSE,
    mt = NULL,
    xferopts = FALSE,
    path = NULL,
    progress = NULL,
    plot.qc = FALSE,
    qc = FALSE,
    requantify_multiome = FALSE, 
    requantify_genes = FALSE,
    score = FALSE,
    sctransform = FALSE,
    start = numeric(length = 0L),
    transform = FALSE
  )
  if (isTRUE(x = do.adt)) {
    output$imputedlabel <- renderUI(expr = h3('Imputed protein biomarkers'))
  } else {
    for (id in c('imputedinput', 'imputedtable', 'imputeddl')) {
      removeUI(selector = paste0('#', id), immediate = TRUE)
    }
    for (id in c('featureinput', 'scoreinput')) {
      removeClass(id = id, class = 'thirds')
      addClass(id = id, class = 'halves')
    }
    removeClass(id = 'biotable', class = 'halves')
    addClass(id = 'biotable', class = 'fulls')
  }
  if (!isTRUE(x = do.bridge)) {
    for (id in c('dist.qc', 'q4', 'valuebox_overlap', 'valuebox_jaccard', 'motifinput', 'continput.motif', 'metagroup.motif', 'motifvln', 'markerclustersgroupinput.motif', 'motiftable', 'overlap_box')) {
      removeUI(selector = paste0('#', id), immediate = TRUE)
    }
  }
  ResetEnv <- function() {
    print('resetting...')
    app.env$disable <- TRUE
    output$menu2 <- NULL
    react.env$plot.qc <- FALSE
    app.env$messages <- NULL
    output$valubox.jaccard <- NULL
    output$valubox.upload <- NULL
    output$valuebox.preproc <- NULL
    output$valuebox.mapped <- NULL
    output$valuebox_overlap <- NULL
    output$valuebox_jaccard <- NULL
    output$valuebox_panchors <- NULL
    output$valuebox_mappingqcstat <- NULL
    app.env$emptyref <- NULL
    app.env$merged <- NULL
    app.env$metadata.discrete <- NULL
    disable(id = 'map')
    hide(selector = '.rowhide')
  }
  motif.proxy <- dataTableProxy(outputId = "motifs")
  rna.proxy <- dataTableProxy(outputId = 'biomarkers')
  adt.proxy <- dataTableProxy(outputId = 'adtbio')
  logging <- all(vapply(
    X = paste0('Azimuth.app.google', c('sheet', 'token', 'tokenemail')),
    FUN = function(x) {
      return(!is.null(x = getOption(x = x)))
    },
    FUN.VALUE = logical(length = 1L)
  ))
  googlesheet <- NULL
  if (logging) {
    try(
      expr = {
        token <- readRDS(getOption(x = "Azimuth.app.googletoken"))
        gs4_auth(email = getOption(x = "Azimuth.app.googletokenemail"), 
                 token = token)
        googlesheet <- gs4_get(ss = getOption(x = "Azimuth.app.googlesheet"))
        app_start_time <- Sys.time()
        app_session_id <- paste0(Sys.info()[["nodename"]], as.numeric(Sys.time()))
        onStop(
          fun = function() {
            try(expr = sheet_append(
              ss = googlesheet,
              data = data.frame(
                "SESSIONLENGTH",
                app_session_id,
                as.numeric(x = Sys.time() - app_start_time, units = "mins")
              )
            ))
          }
        )
      }
    )
  }
  if (!is.null(x = googlesheet)) {
    try(expr = sheet_append(
      ss = googlesheet,
      data = data.frame(
        "STARTUPTIME",
        app_session_id,
        Sys.time()
      )
    ))
    output$menu3 <- renderMenu(expr = {
      sidebarMenu(menuItem(
        text = 'Feedback',
        tabName = 'tab_feedback',
        icon = icon(name = 'comments'),
        selected = FALSE
      ))
    })
  }
  demos <- getOption("Azimuth.app.demodataset")
  if (!is.null(x = demos)) {
    if (!inherits(x = demos, what = "data.frame")) {
      if (is.null(x = names(x = demos))) {
        if (length(x = demos) > 1) {
          demo.names <- paste0("Demo", 1:length(x = demos))
        } else {
          demo.names <- "Load demo dataset"
        }
      } else {
        demo.names <- names(x = demos)
      }
      demos <- data.frame(name = demo.names, file = demos)
    }
    app.env$demo.files <- demos$file
    app.env$demo.inputs <- paste0("triggerdemo", 1:nrow(x = demos))
    app.env$demo.tracker <- rep(x = 0, times = nrow(x = demos))
    for (i in 1:nrow(x = demos)) {
      insertUI(
        selector = '#demobuttons',
        where = 'beforeEnd',
        immediate = TRUE,
        ui = actionButton(
          inputId = paste0('triggerdemo', i),
          label = demos$name[i],
          width = '85%'
        )
      )
    }
  }
  if (getOption(x = "Azimuth.app.metatableheatmap")) {
    insertUI(
      selector = '#tablemetadata',
      where = 'beforeEnd',
      immediate = TRUE,
      ui = plotlyOutput(outputId = 'metadata.heatmap')
    )
  } else {
    insertUI(
      selector = '#tablemetadata',
      where = 'beforeEnd',
      immediate = TRUE,
      ui = tableOutput(outputId = 'metadata.table')
    )
  }
  if (getOption(x = "Azimuth.app.overlayedreference")) {
    insertUI(
      selector = "#topdim",
      where = "beforeEnd",
      immediate = TRUE,
      ui = box(
        title = 'Mapped Query',
        checkboxInput(inputId = 'legend', label = 'Show legend'),
        checkboxGroupInput(
          inputId = "label.opts", label = NULL,
          choiceNames = c("Show labels", "Filter cluster labels (size <2%)"),
          choiceValues = c("labels", "filterlabels"),
          selected = c("labels", "filterlabels"), inline = TRUE),
        checkboxInput(inputId = 'showrefonly', label = 'View reference only'),
        selectizeInput(
          inputId = 'metacolor.ref',
          label = 'Reference metadata to color by',
          choices = '',
          multiple = TRUE,
        ),
        selectizeInput(
          inputId = 'metacolor.query',
          label = 'Query metadata to color by',
          choices = '',
          multiple = TRUE,
        ),
        div(
          style = "position:relative",
          plotOutput(
            outputId = 'objdim',
            hover = hoverOpts(
              id = "objdim_hover_location",
              delay = 5,
              delayType = "debounce",
              nullOutside = TRUE
            ),
            height='750px'
          ),
          uiOutput("objdim_hover_box")
        ),
        width = 12,
        height = 'auto'
      )
    )
  } else {
    insertUI(
      selector = "#topdim",
      where = "beforeEnd",
      immediate = TRUE,
      ui = box(
        title = 'Reference',
        checkboxGroupInput(inputId = "dimplot.opts", label = NULL, choiceNames = c("Show labels", "Show legend"), choiceValues = c("labels", "legend"), selected = "legend", inline = TRUE),
        selectizeInput(
          inputId = 'metacolor.ref',
          label = 'Metadata to color by',
          choices = '',
          multiple = TRUE,
        ),
        div(
          style = "position:relative",
          plotOutput(
            outputId = 'refdim',
            hover = hoverOpts(
              id = "refdim_hover_location",
              delay = 5,
              delayType = "debounce",
              nullOutside = TRUE
            )
          ),
          uiOutput("refdim_hover_box")
        ),
        width = 12
      )
    )
    insertUI(
      selector = "#bottomdim",
      where = "beforeEnd",
      immediate = TRUE,
      ui = box(
        title = 'Query',
        selectizeInput(
          inputId = 'metacolor.query',
          label = 'Metadata to color by',
          choices = '',
          multiple = TRUE,
        ),
        div(
          style = "position:relative",
          plotOutput(
            outputId = 'querydim',
            hover = hoverOpts(
              id = "querydim_hover_location",
              delay = 5,
              delayType = "debounce",
              nullOutside = TRUE
            )
          ),
          uiOutput("querydim_hover_box")
        ),
        width = 12
      )
    )
  }
  if (isTRUE(x = do.bridge)) {
    withProgress(
      message = "Loading bridge and reference",
      expr = {
        disable(id = 'file')
        ToggleDemos(action = "disable", demos = demos)
        setProgress(value = 0.2)
        refs <- LoadBridgeReference(
          path = getOption(
            x = 'Azimuth.app.reference',
            default = stop(safeError(error = "No reference provided"))
          )
        )
        setProgress(value = 1)
        enable(id = 'file')
        ToggleDemos(action = "enable", demos = demos)
        react.env$bridge <- TRUE
      }
    )
  } else {
    withProgress(
      message = "Loading reference",
      expr = {
        disable(id = 'file')
        ToggleDemos(action = "disable", demos = demos)
        setProgress(value = 0)
        refs <- LoadReference(
          path = getOption(
            x = 'Azimuth.app.reference',
            default = stop(safeError(error = "No reference provided"))
          )
        )
        setProgress(value = 1)
        enable(id = 'file')
        ToggleDemos(action = "enable", demos = demos)
        react.env$standard = TRUE
      }
    )
  }
  if (!is.null(x = googlesheet)) {
    try(
      expr = sheet_append(
        ss = googlesheet,
        data = data.frame(
          c('REFERENCE_NAME', "REFERENCE_VERSION"),
          c(app_session_id, app_session_id),
          c(basename(getOption(x = 'Azimuth.app.reference')),  ReferenceVersion(object = refs$map))
        )
      ),
      silent = TRUE
    )
  }
  plotseed <- getOption(x = "Azimuth.app.plotseed")
  if (!is.null(x = plotseed)) {
    set.seed(seed = plotseed)
    colormap <- GetColorMap(object = refs$map)
    for (i in names(x = colormap)) {
      names(x = colormap[[i]]) <- sample(x = names(x = colormap[[i]]))
    }
    refs$map <- SetColorMap(object = refs$map, value = colormap)
  }
  metadata.annotate <- names(x = GetColorMap(object = refs$map))
  if (!is.null(x = getOption(x = "Azimuth.app.metadata_notransfer", default = NULL))) {
    metadata.notransfer <- str_trim(
      str_split(
        getOption(x = "Azimuth.app.metadata_notransfer", default = NULL),
        ','
      )[[1]]
    )
    possible.metadata.transfer <- setdiff(x = metadata.annotate, y = metadata.notransfer)
  } else {
    possible.metadata.transfer <- metadata.annotate
  }
  if (length(x = possible.metadata.transfer) > 1) {
    react.env$xferopts <- TRUE
  }
  default_xfer <- getOption(x = "Azimuth.app.default_metadata", default = possible.metadata.transfer[1])
  if (!default_xfer %in% possible.metadata.transfer) {
    default_xfer <- possible.metadata.transfer[1]
  }
  # React to events
  # Load the data and prepare for QC
  observeEvent(
    eventExpr = input$file,
    handlerExpr = {
      ResetEnv()
      if (nchar(x = input$file$datapath)) {
        react.env$path <- input$file$datapath
      }
    }
  )
  observeEvent(
    eventExpr = sapply(X = app.env$demo.inputs, FUN = function(x) input[[x]]),
    handlerExpr = {
      if (isTRUE(x = !all(sapply(X = app.env$demo.inputs, FUN = is.null)))) {
        ResetEnv()
        for (i in 1:length(x = app.env$demo.inputs)) {
          if (isTRUE(x = input[[app.env$demo.inputs[i]]] != app.env$demo.tracker[i])) {
            app.env$demo.tracker[i] <- app.env$demo.tracker[i] + 1
            react.env$path <- app.env$demo.files[i]
          }
        }
      }
    },
    ignoreInit = TRUE
  )
  observeEvent(
    eventExpr = list(react.env$path, react.env$standard),
    handlerExpr = {
      if (!is.null(x = react.env$path) && nchar(x = react.env$path)) {
        if (isTRUE(react.env$standard)) {
          withProgress(
            message = 'Reading Input',
            expr = {
              setProgress(value = 0)
              tryCatch(
                expr = {
                  app.env$object <- LoadFileInput(path = react.env$path)
                  app.env$object <- DietSeurat(
                    app.env$object,
                    assays = "RNA"
                  )
                  app.env$object <- ConvertGeneNames(
                    object = app.env$object,
                    reference.names = rownames(x = refs$map),
                    homolog.table = getOption(x = 'Azimuth.app.homologs')
                  )
                  if (react.env$path %in% app.env$demo.files) {
                    app.env$demo <- TRUE
                  } else {
                    app.env$demo <- FALSE
                  }
                  app.env$object$query <- 'query'
                  Idents(object = app.env$object) <- 'query'
                  # check that no names overlap with reference
                  query.cell.names <- paste0("query", 1:ncol(x = app.env$object))
                  while (any(query.cell.names %in% Cells(x = refs$map))) {
                    query.cell.names <- paste0(query.cell.names, "x")
                  }
                  app.env$query.names <- Cells(x = app.env$object)
                  app.env$object <- RenameCells(object = app.env$object, new.names = query.cell.names)
                  
                  app.env$default.assay <- DefaultAssay(object = app.env$object)
                  new.mt <- any(grepl(
                    pattern = mito.pattern,
                    x = rownames(x = app.env$object)
                  ))
                  if (isFALSE(x = new.mt) & !isFALSE(x = react.env$mt)) {
                    removeUI(selector = '#pctmt', immediate = TRUE)
                  } else if (!isFALSE(x = new.mt) & isFALSE(x = react.env$mt)) {
                    insertUI(
                      selector = '#nfeature',
                      where = 'afterEnd',
                      immediate = TRUE,
                      ui = div(
                        id = 'pctmt',
                        numericInput(
                          inputId = 'minmt',
                          label = NULL,
                          value = 0,
                          width = '90%'
                        ),
                        numericInput(
                          'maxmt',
                          label = NULL,
                          value = 0,
                          width = '90%'
                        )
                      )
                    )
                  }
                  react.env$mt <- new.mt
                  common.features <- intersect(
                    x = rownames(x = app.env$object),
                    y = rownames(x = refs$map)
                  )
                  reject <- c(
                    length(x = common.features) < getOption(x = 'Azimuth.map.ngenes'),
                    length(x = Cells(x = app.env$object)) > getOption(x = 'Azimuth.app.max_cells')
                  )
                  if (any(reject)) {
                    app.env$object <- NULL
                    gc(verbose = FALSE)
                    reject <- min(which(x = reject))
                    app.env$messages <- paste(
                      c(
                        'Not enough genes in common with reference.',
                        'Too many cells.'
                      ),
                      'Try another dataset.'
                    )[reject]
                  }
                  if (isFALSE(x = react.env$xferopts)) {
                    removeUI(selector = '#xferopts', immediate = TRUE)
                  }
                  react.env$qc <- !any(reject)
                  react.env$path <- NULL
                },
                error = function(e) {
                  app.env$messages <- e$message
                  showNotification(
                    e$message,
                    duration = 10,
                    type = 'error',
                    closeButton = TRUE,
                    id = 'no-progress-notification'
                  )
                  app.env$object <- NULL
                  gc(verbose = FALSE)
                  react.env$path <- NULL
                }
              )
              setProgress(value = 1)
            }
          )
        }   
      }
    }
  )
  observeEvent(
    eventExpr = list(react.env$path, react.env$bridge),
    handlerExpr = {
      if (!is.null(x = react.env$path) && nchar(x = react.env$path)) {
        if (isTRUE(react.env$bridge)) {
          withProgress(
            message = 'Reading ATAC Peaks',
            expr = {
              setProgress(value = 0)
              tryCatch(
                expr = {
                  app.env$counts <- LoadFileInput(path = react.env$path, 
                                                  bridge = TRUE)
                  
                  app.env$counts <- DietSeurat(
                    app.env$counts,
                    assays = "RNA"
                  )
                  # app.env$object <- ConvertGeneNames(
                  #   object = app.env$object,
                  #   reference.names = rownames(x = refs$map),
                  #   homolog.table = getOption(x = 'Azimuth.app.homologs')
                  # )
                  if (react.env$path %in% app.env$demo.files) {
                    app.env$demo <- TRUE
                  } else {
                    app.env$demo <- FALSE
                  }
                  app.env$counts$query <- 'query'
                  react.env$chromatin_assay_1 <- TRUE
                  react.env$path <- NULL
                },
                error = function(e) {
                  app.env$messages <- e$message
                  showNotification(
                    e$message,
                    duration = 10,
                    type = 'error',
                    closeButton = TRUE,
                    id = 'no-progress-notification'
                  )
                  app.env$object <- NULL
                  gc(verbose = FALSE)
                  react.env$path <- NULL
                }
              )
              setProgress(value = 0.3)
            }
          )
        }
      }
    }
  )
  observeEvent(
    eventExpr = react.env$chromatin_assay_1, 
    handlerExpr = {
      if (isTRUE(x = react.env$chromatin_assay_1)) {
        withProgress(message = "Making Chromatin Assay", expr = {
          setProgress(value = 0.3)
          tryCatch(expr = {
            app.env$annotations <- refs$map[["ATAC"]]@annotation
            app.env$chromatin_assay_1 <- CreateChromatinAssay(
              counts = app.env$counts[["RNA"]]$counts, 
              sep = c(":", "-"),
              annotation = app.env$annotations
            )
            perc_overlap <- round(x = OverlapTotal(app.env$chromatin_assay_1, refs$map[["ATAC"]]), digits = 4)
            if (perc_overlap >= 70) {
              output$valuebox_overlap <- renderValueBox(expr = {
                valueBox(value = perc_overlap, subtitle = "Overlap Percentage",
                         icon = icon(name = "check"), color = "green")
              })
            }
            else if (perc_overlap < 70 & perc_overlap > 50) {
              output$valuebox_overlap<- renderValueBox(expr = {
                valueBox(value = perc_overlap, subtitle = "Overlap Percentage",
                         icon = icon(name = "exclamation-circle"), color = "yellow")
              })
            }
            else {
              output$valuebox_overlap <- renderValueBox(expr = {
                valueBox(value = perc_overlap, subtitle = "Overlap Percentage Too Low",
                         icon = icon(name = "exclamation-circle"), color = "red")
              })
            }
            jaccard <- round(x = PeakJaccard(app.env$chromatin_assay_1, refs$map[["ATAC"]]), digits = 4)
            if (jaccard >= 30) {
              output$valuebox_jaccard <- renderValueBox(expr = {
                valueBox(value = jaccard, subtitle = "Jaccard Similarity",
                         icon = icon(name = "check"), color = "green")
              })
            }
            else if (jaccard < 30 & jaccard > 20) {
              output$valuebox_jaccard<- renderValueBox(expr = {
                valueBox(value = jaccard, subtitle = "Jaccard Similarity",
                         icon = icon(name = "exclamation-circle"), color = "yellow")
              })
              
            }
            else {
              output$valuebox_jaccard <- renderValueBox(expr = {
                valueBox(value = jaccard, subtitle = "Jaccard Similarity is Low",
                         icon = icon(name = "exclamation-circle"), color = "red")
              })
            }
            query.cell.names <- paste0("query", 1:ncol(x = app.env$chromatin_assay_1))
            while (any(query.cell.names %in% Cells(x = refs$map))) {
              query.cell.names <- paste0(query.cell.names, 
                                         "x")
            }
            app.env$query.names <- Cells(x = app.env$chromatin_assay_1)
            app.env$chromatin_assay_1 <- RenameCells(object = app.env$chromatin_assay_1, 
                                                     new.names = query.cell.names)
            
            # remove this because we don't have mitochondrial genes, just peaks 
            removeUI(selector = '#pctmt', immediate = TRUE)
            react.env$mt <- FALSE
            
            react.env$requantify_multiome <- TRUE
            react.env$chromatin_assay_1 <- FALSE
          }, error = function(e) {
            app.env$messages <- e$message
            showNotification(e$message, duration = 10, 
                             type = "error", closeButton = TRUE, id = "no-progress-notification")
            app.env$chromatin_assay_1 <- NULL
            gc(verbose = FALSE)
            react.env$chromatin_assay_1 <- NULL
          })
          setProgress(value = 0.4)
        }
        )
      }
    })
  observeEvent(
    eventExpr = react.env$requantify_multiome, 
    handlerExpr = {
      if (isTRUE(x = react.env$requantify_multiome)) {
        withProgress(message = "Requantifying Peaks to Match Bridge", expr = {
          setProgress(value = 0.5)
          tryCatch(expr = {
            app.env$requantified_multiome <- RequantifyPeaks(app.env$chromatin_assay_1, refs$map)
            app.env$chromatin_assay_2 <- CreateChromatinAssay(
              counts = app.env$requantified_multiome,
              sep = c(":", "-"),
              annotation = app.env$annotations
            )
            app.env$object <- CreateSeuratObject(counts = app.env$chromatin_assay_2, assay = 'ATAC')
            app.env$object[['peak.orig']] <- app.env$chromatin_assay_1
            app.env$object$query <- "query"
            app.env$default.assay <- DefaultAssay(app.env$object)
            
            common.features <- intersect(
              x = rownames(x = app.env$object),
              y = rownames(x = refs$map[["ATAC"]])
            )
            reject_peaks <- c(
              length(x = common.features) < getOption(x = 'Azimuth.map.ngenes'),
              length(x = Cells(x = app.env$object)) > getOption(x = 'Azimuth.app.max_cells')
            )
            if (any(reject_peaks)) {
              app.env$object <- NULL
              gc(verbose = FALSE)
              reject_peaks <- min(which(x = reject_peaks))
              app.env$messages <- paste(
                c(
                  'Not enough peaks in common with reference.',
                  'Too many cells.'
                ),
                'Try another dataset.'
              )[reject_peaks]
            }
            if (isFALSE(x = react.env$xferopts)) {
              removeUI(selector = '#xferopts', immediate = TRUE)
            }
            
            react.env$qc <- !any(reject_peaks)
            react.env$requantify_multiome <- FALSE
          }, error = function(e) {
            app.env$messages <- e$message
            showNotification(e$message, duration = 10, 
                             type = "error", closeButton = TRUE, id = "no-progress-notification")
            app.env$chromatin_assay_2 <- NULL
            gc(verbose = FALSE)
            react.env$requantify_multiome <- NULL
          })
          setProgress(value = 1)
        }
        )
      }
    })
  observeEvent(
    eventExpr = react.env$qc,
    handlerExpr = {
      if (isTRUE(x = react.env$qc)) {
        for (id in qc.ids) {
          try(expr = enable(id = id), silent = TRUE)
        }
        ncount <- paste0('nCount_', app.env$default.assay)
        nfeature <- paste0('nFeature_', app.env$default.assay)
        if (!all(c(ncount, nfeature) %in% colnames(x = app.env$object[[]]))) {
          withProgress(
            message = 'Calculating nCount and nFeature',
            expr = {
              setProgress(value = 0)
              calcn <- as.data.frame(x = Seurat:::CalcN(object = GetAssayData(app.env$object, slot = "counts")))
              colnames(x = calcn) <- paste(
                colnames(x = calcn),
                app.env$default.assay,
                sep = '_'
              )
              app.env$object <- AddMetaData(
                object = app.env$object,
                metadata = calcn
              )
              rm(calcn)
              gc(verbose = FALSE)
              setProgress(value = 1)
            }
          )
        }
        ncount.val <- range(app.env$object[[ncount, drop = TRUE]])
        ncount.val <- c(
          floor(x = min(ncount.val)),
          ceiling(x = max(ncount.val))
        )
        ncount.min <- if (is.null(getOption(x = "Azimuth.app.ncount_min"))) {
          ncount.val[1]
        } else {
          max(ncount.val[1], getOption(x = "Azimuth.app.ncount_min"))
        }
        ncount.max <- if (is.null(getOption(x = "Azimuth.app.ncount_max"))) {
          ncount.val[2]
        } else {
          min(ncount.val[2], getOption(x = "Azimuth.app.ncount_max"))
        }
        updateNumericInput(
          session = session,
          inputId = 'num.ncountmin',
          label = paste('min', ncount),
          value = ncount.min,
          min = ncount.val[1],
          max = ncount.val[2]
        )
        updateNumericInput(
          session = session,
          inputId = 'num.ncountmax',
          label = paste('max', ncount),
          value = ncount.max,
          min = ncount.val[1],
          max = ncount.val[2]
        )
        nfeature.val <- range(app.env$object[[nfeature, drop = TRUE]])
        nfeature.val <- c(
          floor(x = min(nfeature.val)),
          ceiling(x = max(nfeature.val))
        )
        nfeature.min <- if (is.null(getOption(x = "Azimuth.app.nfeature_min"))) {
          nfeature.val[1]
        } else {
          max(nfeature.val[1], getOption(x = "Azimuth.app.nfeature_min"))
        }
        nfeature.max <- if (is.null(getOption(x = "Azimuth.app.nfeature_max"))) {
          nfeature.val[2]
        } else {
          min(nfeature.val[2], getOption(x = "Azimuth.app.nfeature_max"))
        }
        updateNumericInput(
          session = session,
          inputId = 'num.nfeaturemin',
          label = paste('min', nfeature),
          value = nfeature.min,
          min = nfeature.val[1],
          max = nfeature.val[2]
        )
        updateNumericInput(
          session = session,
          inputId = 'num.nfeaturemax',
          label = paste('max', nfeature),
          value = nfeature.max,
          min = nfeature.val[1],
          max = nfeature.val[2]
        )
        if (isTRUE(x = react.env$mt)) {
          app.env$object <- PercentageFeatureSet(
            object = app.env$object,
            pattern = mito.pattern,
            col.name = mt.key,
            assay = app.env$default.assay
          )
          mito.val <- range(app.env$object[[mt.key, drop = TRUE]])
          mito.val <- c(
            floor(x = min(mito.val)),
            ceiling(x = max(mito.val))
          )
          mito.min <- if (is.null(getOption(x = "Azimuth.app.pctmt_min"))) {
            mito.val[1]
          } else {
            max(mito.val[1], getOption(x = "Azimuth.app.pctmt_min"))
          }
          mito.max <- if (is.null(getOption(x = "Azimuth.app.pctmt_max"))) {
            mito.val[2]
          } else {
            min(mito.val[2], getOption(x = "Azimuth.app.pctmt_max"))
          }
          updateNumericInput(
            session = session,
            inputId = 'minmt',
            label = paste('min', mt.key),
            value = mito.min,
            min = mito.val[1],
            max = mito.val[2]
          )
          updateNumericInput(
            session = session,
            inputId = 'maxmt',
            label = paste('max', mt.key),
            value = mito.max,
            min = mito.val[1],
            max = mito.val[2]
          )
        }
        output$menu1 <- renderMenu(expr = {
          sidebarMenu(menuItem(
            text = 'Preprocessing',
            tabName = 'tab_preproc',
            icon = icon(name = 'filter'),
            selected = TRUE
          ))
        })
        ncellsupload <- length(x = colnames(x = app.env$object))
        app.env$ncellsupload <- ncellsupload
        app.env$messages <- paste(ncellsupload, 'cells uploaded')
        if (ncellsupload < getOption(x = 'Azimuth.map.ncells')) {
          output$valuebox.upload <- renderValueBox(expr = {
            valueBox(
              value = ncellsupload,
              subtitle = paste0(
                'cells uploaded - ',
                getOption(x = 'Azimuth.map.ncells'), ' required'
              ),
              icon = icon(name = 'times'),
              color = 'red'
            )
          })
        } else {
          output$valuebox.upload <- renderValueBox(expr = {
            valueBox(
              value = ncellsupload,
              subtitle = 'cells uploaded',
              icon = icon(name = 'check'),
              color = 'green'
            )
          })
          if (!is.null(x = googlesheet)) {
            try(
              expr = sheet_append(
                ss = googlesheet,
                data = data.frame(
                  'CELLSUPLOAD',
                  app_session_id,
                  ncellsupload
                )
              ),
              silent = TRUE
            )
          }
        }
        if (!is.null(x = react.env$progress)) {
          react.env$progress$close()
          enable(id = 'file')
          ToggleDemos(action = "enable", demos = demos)
          react.env$progress <- NULL
        }
        updateSelectizeInput(
          session = session,
          inputId = 'metadataxfer',
          choices = possible.metadata.transfer,
          selected = default_xfer,
          server = TRUE,
          options = selectize.opts[-which(x = names(x = selectize.opts) == 'maxItems')]
        )
        react.env$qc <- FALSE
        react.env$plot.qc <- TRUE
        if (isTRUE(x = do.bridge)) {
          react.env$dist.qc <- TRUE
        }
      }
    }
  )
  observeEvent(
    eventExpr = input$metadataxfer,
    handlerExpr = {
      if (length(x = input$metadataxfer) == 0) {
        disable(id = 'map')
      } else {
        enable(id = 'map')
      }
    },
    ignoreNULL = FALSE
  )
  # Filter and process the data
  observeEvent(
    eventExpr = input$map,
    handlerExpr = {
      react.env$start <- Sys.time()
      disable(id = 'file')
      ToggleDemos(action = "disable", demos = demos)
      for (id in qc.ids) {
        try(expr = disable(id = id), silent = TRUE)
      }
      react.env$progress <- Progress$new(style = 'notification')
      react.env$progress$set(
        value = 0,
        message = 'Filtering based on nCount and nFeature'
      )
      ncount <- paste0('nCount_', DefaultAssay(object = app.env$object))
      nfeature <- paste0('nFeature_', DefaultAssay(object = app.env$object))
      cells.use <- app.env$object[[ncount, drop = TRUE]] >= input$num.ncountmin &
        app.env$object[[ncount, drop = TRUE]] <= input$num.ncountmax &
        app.env$object[[nfeature, drop = TRUE]] >= input$num.nfeaturemin &
        app.env$object[[nfeature, drop = TRUE]] <= input$num.nfeaturemax
      if (isTRUE(x = react.env$mt)) {
        cells.use <- cells.use &
          app.env$object[[mt.key, drop = TRUE]] >= input$minmt &
          app.env$object[[mt.key, drop = TRUE]] <= input$maxmt
      }
      ncellspreproc <- sum(cells.use)
      app.env$ncellspreproc <- ncellspreproc
      # not enough cells available after filtering: reset filter elements
      if (ncellspreproc < getOption(x = "Azimuth.map.ncells")) {
        output$valuebox.preproc <- renderValueBox(expr = valueBox(
          value = ncellspreproc,
          subtitle = paste0(
            'cells after filtering - ',
            getOption(x = 'Azimuth.map.ncells'), ' required'
          ),
          icon = icon("times"),
          color = "red"
        ))
        react.env$qc <- TRUE
      } else {
        output$valuebox.preproc <- renderValueBox(expr = valueBox(
          value = ncellspreproc,
          subtitle = "cells after filtering",
          icon = icon("check"),
          color = "green"
        ))
        if (!is.null(googlesheet)) {
          try(sheet_append(
            ss = googlesheet,
            data = data.frame(
              "CELLSPREPROC",
              app_session_id,
              ncellspreproc
            )
          ))
        }
        app.env$object <- app.env$object[, cells.use]
        app.env$query.names <- app.env$query.names[cells.use]
        if (isTRUE(x = do.bridge)) {
          react.env$tfidf <- TRUE
        } else {
          react.env$sctransform <- TRUE
        }
      }
    }
  )
  observeEvent(
    eventExpr = react.env$sctransform,
    handlerExpr = {
      if (isTRUE(x = react.env$sctransform)) {
        react.env$progress$set(
          value = 0.2,
          message = 'Normalizing with SCTransform'
        )
        tryCatch(
          expr = {
            app.env$object <- suppressWarnings(expr = SCTransform(
              object = app.env$object,
              residual.features = rownames(x = refs$map),
              reference.SCT.model = slot(object = refs$map[["refAssay"]], name = "SCTModel.list")[["refmodel"]],
              method = "glmGamPoi",
              do.correct.umi = FALSE,
              do.scale = FALSE,
              do.center = TRUE,
              new.assay.name = "refAssay"
            ))
          },
          error = function(e) {
            app.env$object <- suppressWarnings(expr = SCTransform(
              object = app.env$object,
              residual.features = rownames(x = refs$map),
              reference.SCT.model = slot(object = refs$map[["refAssay"]], name = "SCTModel.list")[["refmodel"]],
              method = "poisson",
              do.correct.umi = FALSE,
              do.scale = FALSE,
              do.center = TRUE,
              new.assay.name = "refAssay"
            ))
          }
        )
        app.env$object[[paste0(c("nCount_", "nFeature_"), "refAssay")]] <- app.env$object[[paste0(c("nCount_", 
                                                                                                    "nFeature_"), 
                                                                                                  "RNA")]]
        app.env$messages <- c(
          app.env$messages,
          paste(ncol(x = app.env$object), "cells preprocessed")
        )
        react.env$anchors <- TRUE
        react.env$sctransform <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$tfidf, 
    handlerExpr = {
      if (isTRUE(x = react.env$tfidf)) {
        react.env$progress$set(
          value = 0.2, 
          message = "Normalizing with TFIDF"
        )
        tryCatch(
          expr = {
            app.env$object <- suppressWarnings(expr = RunTFIDF(object = app.env$object,
                                                               method = 1))
          }, error = function(e) {
            app.env$object <- suppressWarnings(expr = RunTFIDF(object = app.env$object,
                                                               method = 1))
          })
        app.env$messages <- c(
          app.env$messages, 
          paste(ncol(x = app.env$object), "cells preprocessed")
        )
        react.env$bridge_anchors <- TRUE
        react.env$tfidf <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$anchors,
    handlerExpr = {
      if (isTRUE(x = react.env$anchors)) {
        react.env$progress$set(value = 0.3, message = 'Finding anchors')
        app.env$anchors <- FindTransferAnchors(
          reference = refs$map,
          query = app.env$object,
          k.filter = NA,
          reference.neighbors = "refdr.annoy.neighbors",
          reference.assay = "refAssay",
          query.assay = 'refAssay',
          reference.reduction = 'refDR',
          normalization.method = 'SCT',
          recompute.residuals = FALSE,
          features = rownames(x = Loadings(refs$map[["refDR"]])), 
          dims = 1:getOption(x = "Azimuth.map.ndims"),
          n.trees = n.trees,
          verbose = TRUE,
          mapping.score.k = 100
        )
        nanchors <- nrow(x = slot(object = app.env$anchors, name = "anchors"))
        app.env$nanchors <- nanchors
        if (!is.null(googlesheet)) {
          try(sheet_append(
            ss = googlesheet,
            data = data.frame(
              "NANCHORS",
              app_session_id,
              nanchors
            )
          ))
        }
        if (nanchors < getOption(x = 'Azimuth.map.nanchors') |
            length(x = unique(x = slot(
              object = app.env$anchors, name = "anchors")[, 2]
            )) < 50
        ) {
          output$valuebox.mapped <- renderValueBox(expr = {
            valueBox(
              value = 'Failure',
              subtitle = paste0('Too few anchors identified (', nanchors, ')'),
              icon = icon(name = 'times'),
              color = 'red',
              width = 6
            )
          })
          app.env$object <- NULL
          app.env$anchors <- NULL
          react.env$progress$close()
          enable(id = 'file')
          ToggleDemos(action = "enable", demos = demos)
          gc(verbose = FALSE)
        } else {
          query.unique <- length(x = unique(x = slot(object = app.env$anchors, name = "anchors")[, "cell2"]))
          percent.anchors <- round(x = query.unique / ncol(x = app.env$object) * 100, digits = 2)
          if (percent.anchors <  getOption(x = "Azimuth.map.panchorscolors")[1]) {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(
                value = paste0(percent.anchors, "%"),
                subtitle = "% of query cells with anchors",
                color = 'red',
                icon = icon(name = 'times')
              )
            })
          } else if (percent.anchors <  getOption(x = "Azimuth.map.panchorscolors")[2]) {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(
                value = paste0(percent.anchors, "%"),
                subtitle = "% of query cells with anchors",
                color = 'yellow',
                icon = icon(name = 'exclamation-circle')
              )
            })
          } else {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(
                value = paste0(percent.anchors, "%"),
                subtitle = "% of query cells with anchors",
                color = 'green',
                icon = icon(name = 'check')
              )
            })
          }
          react.env$map <- TRUE
        }
        react.env$anchors <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$bridge_anchors, 
    handlerExpr = {
      if (isTRUE(x = react.env$bridge_anchors)) {
        react.env$progress$set(value = 0.3, message = "Finding anchors")
        app.env$anchors <- FindBridgeTransferAnchors(extended.reference = refs$map,
                                                     query = app.env$object,
                                                     reduction = "lsiproject",
                                                     scale = FALSE,
                                                     dims = 2:50) # making this a default
        nanchors <- nrow(x = slot(object = app.env$anchors, 
                                  name = "anchors"))
        app.env$nanchors <- nanchors
        if (!is.null(googlesheet)) {
          try(sheet_append(ss = googlesheet, data = data.frame("NANCHORS", 
                                                               app_session_id, nanchors)))
        }
        if (nanchors < getOption(x = "Azimuth.map.nanchors") | 
            length(x = unique(x = slot(object = app.env$anchors, 
                                       name = "anchors")[, 2])) < 50) {
          output$valuebox.mapped <- renderValueBox(expr = {
            valueBox(value = "Failure", subtitle = paste0("Too few anchors identified (", 
                                                          nanchors, ")"), icon = icon(name = "times"), 
                     color = "red", width = 6)
          })
          app.env$object <- NULL
          app.env$anchors <- NULL
          react.env$progress$close()
          enable(id = "file")
          ToggleDemos(action = "enable", demos = demos)
          
          gc(verbose = FALSE)
        }
        else {
          query.unique <- length(x = unique(x = slot(object = app.env$anchors, 
                                                     name = "anchors")[, "cell2"]))
          percent.anchors <- round(x = query.unique/ncol(x = app.env$object) * 
                                     100, digits = 2)
          if (percent.anchors < getOption(x = "Azimuth.map.panchorscolors")[1]) {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(value = paste0(percent.anchors, 
                                      "%"), subtitle = "% of query cells with anchors", 
                       color = "red", icon = icon(name = "times"))
            })
          }
          else if (percent.anchors < getOption(x = "Azimuth.map.panchorscolors")[2]) {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(value = paste0(percent.anchors, 
                                      "%"), subtitle = "% of query cells with anchors", 
                       color = "yellow", icon = icon(name = "exclamation-circle"))
            })
          }
          else {
            output$valuebox_panchors <- renderValueBox(expr = {
              valueBox(value = paste0(percent.anchors, 
                                      "%"), subtitle = "% of query cells with anchors", 
                       color = "green", icon = icon(name = "check"))
            })
          }
          react.env$mapquery <- TRUE
        }
        react.env$bridge_anchors <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = list(react.env$map, input$metadataxfer),
    handlerExpr = {
      if (isTRUE(x = react.env$map)) {
        if (is.null(x = input$metadataxfer)) {
          app.env$metadataxfer <- names(x = GetColorMap(object = refs$map))
        } else {
          app.env$metadataxfer <- input$metadataxfer
        }
        react.env$progress$set(value = 0.5, message = 'Mapping cells')
        refdata <- lapply(X = app.env$metadataxfer, function(x) {
          refs$map[[x, drop = TRUE]]
        })
        names(x = refdata) <- app.env$metadataxfer
        if (do.adt) {
          refdata[["impADT"]] <- GetAssayData(
            object = refs$map[['ADT']],
            slot = 'data'
          )
        }
        app.env$object <- TransferData(
          reference = refs$map,
          query = app.env$object,
          dims = 1:getOption(x = "Azimuth.map.ndims"),
          anchorset = app.env$anchors,
          refdata = refdata,
          n.trees = n.trees,
          store.weights = TRUE
        )
        app.env$singlepred <- NULL
        for(i in app.env$metadataxfer) {
          app.env$singlepred <- c(app.env$singlepred, length(x = unique(x = as.vector(x = app.env$object[[paste0("predicted.", i), drop = TRUE]]))) == 1)
          app.env$object[[paste0("predicted.", i), drop = TRUE]] <- factor(
            x = app.env$object[[paste0("predicted.", i), drop = TRUE]],
            levels = levels(x = refs$map[[i, drop = TRUE]])
          )
        }
        singlepred <- all(app.env$singlepred)
        if (singlepred & (length(x = setdiff(possible.metadata.transfer, app.env$metadataxfer)) > 0)) {
          showNotification(
            paste0("Only one predicted class. Re-running with all metadata."),
            duration = 5,
            type = 'warning',
            closeButton = TRUE,
            id = 'no-progress-notification'
          )
          updateSelectizeInput(
            session = getDefaultReactiveDomain(),
            inputId = 'metadataxfer',
            choices = possible.metadata.transfer,
            selected = possible.metadata.transfer,
          )
          app.env$metadataxfer <- input$metadataxfer
        } else if (singlepred) {
          showNotification(
            paste0(
              "Only one predicted class: ",
              app.env$object[[paste0("predicted.", app.env$metadataxfer[1]), drop = TRUE]][1]
            ),
            duration = 5,
            type = 'warning',
            closeButton = TRUE,
            id = 'no-progress-notification'
          )
          app.env$object <- NULL
          app.env$anchors <- NULL
          react.env$path <- NULL
          react.env$map <- FALSE
          react.env$progress$close()
          enable(id = 'file')
          ToggleDemos(action = "enable", demos = demos)
          gc(verbose = FALSE)
        } else {
          app.env$object <- IntegrateEmbeddings(
            anchorset = app.env$anchors,
            reference = refs$map,
            query = app.env$object,
            reductions = "pcaproject",
            reuse.weights.matrix = TRUE
          )
          if (is.null(x = getOption(x = "Azimuth.app.default_metadata"))) {
            app.env$default.metadata <- names(x = refdata)[1]
          } else {
            if (getOption(x = "Azimuth.app.default_metadata") %in% names(x = refdata)) {
              app.env$default.metadata <- getOption(x = "Azimuth.app.default_metadata")
            } else {
              app.env$default.metadata <- names(x = refdata)[1]
            }
          }
          react.env$score <- TRUE
          # react.env$cluster.score <- TRUE
          react.env$map <- FALSE
        }
      }
    }
  )
  observeEvent(
    eventExpr = list(react.env$mapquery, input$metadataxfer), 
    handlerExpr = {
      if (isTRUE(x = react.env$mapquery)) {
        if (is.null(x = input$metadataxfer)) {
          app.env$metadataxfer <- names(x = GetColorMap(object = refs$map))
        }
        else {
          app.env$metadataxfer <- input$metadataxfer
        }
        react.env$progress$set(value = 0.5, message = "Mapping cells")
        refdata <- as.list(app.env$metadataxfer)
        names(refdata) <- app.env$metadataxfer
        if (do.adt) {
          refdata[["impADT"]] <- GetAssayData(object = refs$map[["ADT"]], 
                                              slot = "data")
        }
        app.env$object <-  MapQuery(anchorset = app.env$anchors,  # deleted transfer data 
                                    reference = refs$map, 
                                    query = app.env$object, 
                                    refdata = refdata,
                                    reduction.model = "refUMAP")
        app.env$singlepred <- NULL
        for (i in app.env$metadataxfer) { 
          app.env$singlepred <- c(app.env$singlepred, 
                                  length(x = unique(x = as.vector(x = app.env$object[[paste0("predicted.", 
                                                                                             i), drop = TRUE]]))) == 1)
          app.env$object[[paste0("predicted.", i), drop = TRUE]] <- factor(x = app.env$object[[paste0("predicted.", 
                                                                                                      i), drop = TRUE]], levels = levels(x = refs$map[[i, 
                                                                                                                                                       drop = TRUE]]))
        }
        singlepred <- all(app.env$singlepred)
        if (singlepred & (length(x = setdiff(possible.metadata.transfer, 
                                             app.env$metadataxfer)) > 0)) {
          showNotification(paste0("Only one predicted class. Re-running with all metadata."), 
                           duration = 5, type = "warning", closeButton = TRUE, 
                           id = "no-progress-notification")
          updateSelectizeInput(session = getDefaultReactiveDomain(), 
                               inputId = "metadataxfer", choices = possible.metadata.transfer, 
                               selected = possible.metadata.transfer, )
          app.env$metadataxfer <- input$metadataxfer
        }
        else if (singlepred) {
          showNotification(paste0("Only one predicted class: ", 
                                  app.env$object[[paste0("predicted.", app.env$metadataxfer[1]), 
                                                  drop = TRUE]][1]), duration = 5, type = "warning", 
                           closeButton = TRUE, id = "no-progress-notification")
          app.env$object <- NULL
          app.env$bridge_anchors <- NULL
          react.env$path <- NULL
          react.env$mapquery <- FALSE
          react.env$progress$close()
          enable(id = "file")
          ToggleDemos(action = "enable", demos = demos)
          gc(verbose = FALSE)
        }
        else {
          if (is.null(x = getOption(x = "Azimuth.app.default_metadata"))) {
            app.env$default.metadata <- names(x = refdata)[1]
          }
          else {
            if (getOption(x = "Azimuth.app.default_metadata") %in% 
                names(x = refdata)) {
              app.env$default.metadata <- getOption(x = "Azimuth.app.default_metadata")
            }
            else {
              app.env$default.metadata <- names(x = refdata)[1]
            }
          }
          #react.env$score <- TRUE - ill do this after getting gene activity scores 
          react.env$gene_activity <- TRUE
          react.env$mapquery <- FALSE
        }
      }
    }
  )
  observeEvent(
    eventExpr = react.env$gene_activity, 
    handlerExpr = {
      if (isTRUE(react.env$gene_activity)) {
        # Use original peaks 
        DefaultAssay(app.env$object) <- "peak.orig"
        app.env$transcripts <- GetTranscripts(app.env$object)
        temp <- RequantifyPeaks(app.env$object, app.env$transcripts)
        #add feature matrix to Chromatin Assay 
        app.env$object[['RNA']] <- CreateAssayObject(counts = temp)
        
        #Normalize the feature data
        app.env$object <- NormalizeData(
          object = app.env$object,
          assay = 'RNA',
          normalization.method = 'LogNormalize',
          scale.factor = median(unlist(app.env$object[[grep("nCount", 
                                                            colnames(app.env$object@meta.data))]]))
        )
        react.env$gene_activity <- FALSE
        react.env$score <- TRUE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$cluster.score,
    handlerExpr = {
      if (isTRUE(react.env$cluster.score)) {
        # post mapping QC
        if (isTRUE(x = do.bridge)){
          qc.stat <- round(
            x = ClusterPreservationScore(
              query = app.env$object,
              ds.amount = getOption(x = "Azimuth.map.postmapqcds"),
              type = "bridge"
            ),
            digits = 2
          )
        } else {
          qc.stat <- round(
            x = ClusterPreservationScore(
              query = app.env$object,
              ds.amount = getOption(x = "Azimuth.map.postmapqcds"),
              type = "standard"
            ),
            digits = 2
          )
        }
        if (!is.null(googlesheet)) {
          try(sheet_append(
            ss = googlesheet,
            data = data.frame(
              "CLUSTERPRESERVATIONQC",
              app_session_id,
              qc.stat
            )
          ))
        }
        app.env$clusterpreservationqc <- qc.stat
        if (qc.stat <  getOption(x = "Azimuth.map.postmapqccolors")[1]) {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'red',
              icon = icon(name = 'times')
            )
          })
        } else if (qc.stat <  getOption(x = "Azimuth.map.postmapqccolors")[2]) {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'yellow',
              icon = icon(name = 'exclamation-circle')
            )
          })
        } else {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'green',
              icon = icon(name = 'check')
            )
          })
        }
        react.env$cluster.score <- FALSE
        react.env$transform <- TRUE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$score,
    handlerExpr = {
      if (isTRUE(x = react.env$score)) {
        react.env$progress$set(
          value = 0.7,
          message = 'Calculating mapping score'
        )
        # post mapping QC
        if (isTRUE(x = do.bridge)){
          app.env$object[['refAssay']] <- app.env$object[['ATAC']]
          DefaultAssay(app.env$object) <- 'refAssay'
          DefaultAssay(app.env$object[["ref.Bridge.reduc"]]) <- 'refAssay'
          app.env$object <- FindTopFeatures(app.env$object,
                                            min.cutoff = "q0")
          qc.stat <- round(
            x = ClusterPreservationScore(
              query = app.env$object,
              ds.amount = getOption(x = "Azimuth.map.postmapqcds"),
              type = "bridge"
            ),
            digits = 2
          )
        } else {
          qc.stat <- round(
            x = ClusterPreservationScore(
              query = app.env$object,
              ds.amount = getOption(x = "Azimuth.map.postmapqcds"),
              type = "standard"
            ),
            digits = 2
          )
        }
        if (!is.null(googlesheet)) {
          try(sheet_append(
            ss = googlesheet,
            data = data.frame(
              "CLUSTERPRESERVATIONQC",
              app_session_id,
              qc.stat
            )
          ))
        }
        app.env$clusterpreservationqc <- qc.stat
        if (qc.stat <  getOption(x = "Azimuth.map.postmapqccolors")[1]) {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'red',
              icon = icon(name = 'times')
            )
          })
        } else if (qc.stat <  getOption(x = "Azimuth.map.postmapqccolors")[2]) {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'yellow',
              icon = icon(name = 'exclamation-circle')
            )
          })
        } else {
          output$valuebox_mappingqcstat <- renderValueBox(expr = {
            valueBox(
              value = paste0(qc.stat, "/5"),
              subtitle = "cluster preservation score",
              color = 'green',
              icon = icon(name = 'check')
            )
          })
        }
        if (isTRUE(x = do.bridge)){
          refdr <- subset(
            x = app.env$anchors@object.list[[1]][["Bridge.reduc"]], # im gonna try calling this Bridge.Reduc
            cells = paste0(Cells(x = app.env$object), "_query")
          )
          refdr <- RenameCells(
            object = refdr, 
            new.names = Cells(x = app.env$object)
          )
          refdr.ref <- subset(
            x = app.env$anchors@object.list[[1]][["Bridge.reduc"]], 
            cells = paste0(Cells(x = refs$map), "_reference")
          )
          refdr.ref <- RenameCells(
            object = refdr.ref, 
            new.names = Cells(x = refs$map[["Bridge"]])
          )
        } else {
          refdr <- subset(
            x = app.env$anchors@object.list[[1]][["pcaproject.l2"]],
            cells = paste0(Cells(x = app.env$object), "_query")
          )
          refdr <- RenameCells(
            object = refdr,
            new.names = Cells(x = app.env$object)
          )
          refdr.ref <- subset(
            x = app.env$anchors@object.list[[1]][["pcaproject.l2"]],
            cells = paste0(Cells(x = refs$map), "_reference")
          )
          refdr.ref <- RenameCells(
            object = refdr.ref,
            new.names = Cells(x = refs$map)
          )
        }
        if (Sys.getenv("RSTUDIO") == "1") {
          plan("sequential")
        }
        # reduce size of object in anchorset
        app.env$anchors@object.list[[1]] <- DietSeurat(
          object = app.env$anchors@object.list[[1]]
        )
        app.env$anchors@object.list[[1]] <- subset(
          x = app.env$anchors@object.list[[1]],
          features = c(rownames(x = app.env$anchors@object.list[[1]])[1])
        )
        app.env$anchors@object.list[[1]] <- RenameCells(
          object = app.env$anchors@object.list[[1]],
          new.names = unname(obj = sapply(
            X = Cells(x = app.env$anchors@object.list[[1]]),
            FUN = function(x) {
              return(gsub(pattern = "_reference", replacement = "", x = x))
            }
          )))
        app.env$anchors@object.list[[1]] <- RenameCells(
          object = app.env$anchors@object.list[[1]],
          new.names = sapply(
            X = Cells(x = app.env$anchors@object.list[[1]]),
            FUN = function(x) {
              return(gsub(pattern = "_query", replacement = "", x = x))
            },
            USE.NAMES = FALSE
          )
        )
        app.env$anchors@object.list[[1]]@meta.data <- data.frame()
        app.env$anchors@object.list[[1]]@active.ident <- factor()
        mapping.score.k <- min(c(
          50,
          length(x = unique(x = app.env$anchors@anchors[, 1])),
          length(x = unique(x = app.env$anchors@anchors[, 2])))
        )
        app.env$mapping.score <- future(
          expr = {
            MappingScore(
              anchors = app.env$anchors@anchors,
              combined.object = app.env$anchors@object.list[[1]],
              query.neighbors =  slot(object = app.env$anchors, name = "neighbors")[["query.neighbors"]],
              query.weights = Tool(object = app.env$object, slot = "TransferData")$weights.matrix,
              query.embeddings = Embeddings(object = refdr),
              ref.embeddings = Embeddings(object = refdr.ref),
              nn.method = "annoy",
              n.trees = n.trees,
              ndim = getOption(x = "Azimuth.map.ndims"),
              kanchors = mapping.score.k
            )
          }
        )
        app.env$object <- AddMetaData(
          object = app.env$object,
          metadata = rep(x = 0, times = ncol(x = app.env$object)),
          col.name = "mapping.score"
        )
        app.env$anchors <- NULL
        rm(refdr)
        gc(verbose = FALSE)
        # react.env$transform <- TRUE
        react.env$cluster.score <- TRUE
        react.env$score <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$transform,
    handlerExpr = {
      if (isTRUE(x = react.env$transform)) {
        if (isTRUE(x = do.bridge)) {
          react.env$progress$set(value = 0.8)
          suppressWarnings(expr = app.env$object[["umap.proj"]] <- app.env$object[["ref.umap"]])
        }
        else {
          react.env$progress$set(value = 0.8, message = 'Running UMAP transform')
          app.env$object[["query_ref.nn"]] <- FindNeighbors(
            object = Embeddings(refs$map[["refDR"]])[, 1:getOption("Azimuth.map.ndims")],
            query = Embeddings(app.env$object[["integrated_dr"]]),
            return.neighbor = TRUE,
            l2.norm = TRUE,
            n.trees = n.trees
          )
          app.env$object <- NNTransform(
            object = app.env$object,
            meta.data = refs$map[[]]
          )
          app.env$object[['umap.proj']] <- RunUMAP(
            object = app.env$object[['query_ref.nn']],
            reduction.model = refs$map[['refUMAP']],
            reduction.key = 'UMAP_'
          )
          app.env$object <- SetAssayData(
            object = app.env$object,
            assay = 'refAssay',
            slot = 'scale.data',
            new.data = new(Class = 'matrix')
          )
        }
        gc(verbose = FALSE)
        app.env$messages <- c(
          app.env$messages,
          paste(ncol(x = app.env$object), "cells mapped")
        )
        react.env$biomarkers <- TRUE
        if (isTRUE(x = do.bridge)) {
          react.env$motif <- TRUE
        }
        react.env$transform <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$biomarkers,
    handlerExpr = {
      if (isTRUE(x = react.env$biomarkers)) {
        react.env$progress$set(
          value = 0.95,
          message = 'Running differential expression'
        )
        app.env$gene.assay <- "RNA"
        for (i in app.env$metadataxfer[!app.env$singlepred]) {
          app.env$diff.expr[[paste(app.env$gene.assay, i, sep = "_")]] <- wilcoxauc(
            X = app.env$object,
            group_by = paste0("predicted.", i),
            assay = 'data',
            seurat_assay = app.env$gene.assay
          )
          if (isTRUE(x = do.adt)) {
            app.env$diff.expr[[paste(adt.key, i, sep = "_")]] <- wilcoxauc(
              X = app.env$object,
              group_by = paste0("predicted.", i),
              assay = 'data',
              seurat_assay = adt.key
            )
          }
        }
        if (isTRUE(x = do.bridge)) {
          output$menu2 <- renderMenu(expr = {
            sidebarMenu(
              menuItem(
                text = "Cell Plots",
                tabName = "tab_cell",
                icon = icon("chart-area")
              ),
              menuItem(
                text = "Feature Plots",
                tabName = "tab_feature",
                icon = icon("chart-area")
              ),
              menuItem(
                text = "Motifs",
                tabName = "tab_motif",
                icon = icon("chart-area")
              ),
              menuItem(
                text = "Download Results",
                tabName = "tab_download",
                icon = icon("file-download")
              )
            )
          })
        } else {
          output$menu2 <- renderMenu(expr = {
            sidebarMenu(
              menuItem(
                text = "Cell Plots",
                tabName = "tab_cell",
                icon = icon("chart-area")
              ),
              menuItem(
                text = "Feature Plots",
                tabName = "tab_feature",
                icon = icon("chart-area")
              ),
              menuItem(
                text = "Download Results",
                tabName = "tab_download",
                icon = icon("file-download")
              )
            )
          })
          # Finalize the log
          mapping.time <- difftime(
            time1 = Sys.time(),
            time2 = react.env$start,
            units = 'secs'
          )
          time.fmt <- FormatDiffTime(dt = mapping.time)
          app.env$messages <- c(
            app.env$messages,
            time.fmt
          )
          if (!is.null(x = googlesheet)) {
            try(expr = sheet_append(
              ss = googlesheet,
              data = data.frame(
                "MAPPINGTIME",
                app_session_id,
                as.numeric(x = mapping.time)
              )
            ))
          }
          if (!is.null(x = googlesheet)) {
            try(
              expr = sheet_append(
                ss = googlesheet,
                data = data.frame(
                  "SUMMARY",
                  app_session_id,
                  basename(getOption(x = 'Azimuth.app.reference')),
                  ReferenceVersion(object = refs$map),
                  app.env$demo,
                  app.env$ncellsupload,
                  app.env$ncellspreproc,
                  as.numeric(x = mapping.time),
                  Sys.Date(),
                  app.env$nanchors,
                  app.env$clusterpreservationqc
                )
              ),
              silent = TRUE
            )
          }
        }
        app.env$object <- RenameCells(object = app.env$object, new.names = app.env$query.names)
        if (!isTRUE(x = do.bridge)) {
          react.env$progress$close()
        }
        enable(id = 'file')
        ToggleDemos(action = "enable", demos = demos)
        react.env$metadata <- TRUE
        react.env$biomarkers <- FALSE
      }
    }
  )
  observeEvent(eventExpr = react.env$motif, handlerExpr = {
    if (isTRUE(x = react.env$motif)) {
      react.env$progress$set(value = 0.98, message = "Running Motif Analysis")
      DefaultAssay(app.env$object) <- "ATAC"
      # Remove peaks on scaffolds 
      main.chroms <- standardChromosomes(BSgenome.Hsapiens.UCSC.hg38)
      keep.peaks <- which(as.character(seqnames(granges(app.env$object))) %in% main.chroms)
      app.env$object[["ATAC"]] <- subset(app.env$object[["ATAC"]], features = rownames(app.env$object[["ATAC"]])[keep.peaks])
      
      pfm <- getMatrixSet(
        x = JASPAR2020,
        opts = list(species = 9606, all_versions = FALSE)
      )
      
      # Find Motifs
      for (i in app.env$metadataxfer[!app.env$singlepred]) {
        app.env$peaks.diff.expr[[paste(app.env$default.assay, i, sep = "_")]] <- wilcoxauc(X = app.env$object,
                                                                                           group_by = paste0("predicted.", i),
                                                                                           assay = "data", 
                                                                                           seurat_assay = app.env$default.assay)
        peaks.list <- split(app.env$peaks.diff.expr[[paste(app.env$default.assay, i, sep = "_")]], 
                            f = app.env$peaks.diff.expr[[paste(app.env$default.assay, i, sep = "_")]]$group)
        motif.list <- list()
        for (num in 1:length(peaks.list)){
          if (nrow(peaks.list[[num]]) > 0){
            peaks.list[[num]] <- peaks.list[[num]][order(peaks.list[[num]]$logFC, decreasing = TRUE), ]
            if (nrow(peaks.list[[num]]) > 1000) {
              top.da.peak <- peaks.list[[num]][1:1000,]$feature   #[peaks.list[[num]]$logFC > 0.5, ]$feature
            } else {
              top.da.peak <- peaks.list[[num]][peaks.list[[num]]$pval < 0.05, ]$feature
            }
            enriched.motifs <- FindMotifs( 
              object = refs$map[["ATAC"]],
              features = top.da.peak)
            enriched.motifs$group <- names(peaks.list[num])
            motif.list[[num]] <- enriched.motifs
          }  
        }
        app.env$motif.diff.expr[[paste(app.env$default.assay, i, sep = "_")]] <- dplyr::bind_rows(motif.list)
        
      }
      # Finalize the log
      mapping.time <- difftime(
        time1 = Sys.time(),
        time2 = react.env$start,
        units = 'secs'
      )
      time.fmt <- FormatDiffTime(dt = mapping.time)
      app.env$messages <- c(
        app.env$messages,
        time.fmt
      )
      if (!is.null(x = googlesheet)) {
        try(expr = sheet_append(
          ss = googlesheet,
          data = data.frame(
            "MAPPINGTIME",
            app_session_id,
            as.numeric(x = mapping.time)
          )
        ))
      }
      if (!is.null(x = googlesheet)) {
        try(
          expr = sheet_append(
            ss = googlesheet,
            data = data.frame(
              "SUMMARY",
              app_session_id,
              basename(getOption(x = 'Azimuth.app.reference')),
              ReferenceVersion(object = refs$map),
              app.env$demo,
              app.env$ncellsupload,
              app.env$ncellspreproc,
              as.numeric(x = mapping.time),
              Sys.Date(),
              app.env$nanchors,
              app.env$clusterpreservationqc
            )
          ),
          silent = TRUE
        )
      }
      react.env$progress$close()
      react.env$motif <- FALSE
    }
  })
  # Update input controls
  observeEvent(
    eventExpr = react.env$metadata,
    handlerExpr = {
      if (isTRUE(x = react.env$metadata)) {
        #  Add the discrete metadata dropdowns
        metadata.discrete <- sort(
          x = PlottableMetadataNames(
            object = app.env$object,
            exceptions = app.env$metadataxfer,
            min.levels = 1,
            max.levels = 50
          )
        )
        app.env$metadata.discrete <- metadata.discrete
        for (id in c('metarow', 'metacol', 'metagroup', 'metagroup.motif')) {
          if (id == 'metarow') {
            show.metadata <- 'query'
          } else {
            show.metadata <- paste0("predicted.", app.env$default.metadata)
          }
          updateSelectizeInput(
            session = session,
            inputId = id,
            choices = metadata.discrete,
            selected = show.metadata,
            server = TRUE,
            options = selectize.opts
          )
        }
        updateSelectizeInput(
          session = session,
          inputId = 'metacolor.query',
          choices = c(grep(pattern = '^predicted.', x = metadata.discrete, value = TRUE),
                      grep(pattern = '^predicted.', x = metadata.discrete, value = TRUE, invert = TRUE)),
          selected = paste0("predicted.", app.env$default.metadata),
          server = TRUE,
          options = selectize.opts[-which(x = names(x = selectize.opts) == 'maxItems')]
        )
        # Add the continuous metadata dropdown
        metadata.cont <- sort(x = setdiff(
          x = colnames(x = app.env$object[[]]),
          y = metadata.discrete
        ))
        metadata.cont <- Filter(
          f = function(x) {
            return(is.numeric(x = app.env$object[[x, drop = TRUE]]))
          },
          x = metadata.cont
        )
        # Add prediction scores for all classes to continuous metadata
        metadata.cont <- sort(x = metadata.cont)
        if (any(grepl(pattern = "predicted.*.score", x = metadata.cont))) {
          metadata.cont <- metadata.cont[-grep(pattern = "predicted.*.score", x = metadata.cont)]
        }
        if (any(grepl(pattern = "*_refAssay", x = metadata.cont))) {
          metadata.cont <- metadata.cont[-grep(pattern = "*_refAssay", x = metadata.cont)]
        }
        max.predictions <- paste0("predicted.", app.env$metadataxfer, ".score")
        names(x = max.predictions) <- app.env$metadataxfer
        max.predictions <- as.list(x = max.predictions)
        prediction.score.names <-
          lapply(X = app.env$metadataxfer, FUN = function(x) {
            key <- Key(object = app.env$object[[paste0("prediction.score.", x)]])
            ids <- paste0(rownames(x = app.env$object[[paste0("prediction.score.", x)]]))
            values <- paste0(key, ids)
            names(x = values) <- ids
            return(values)
          })
        names(x = prediction.score.names) <- paste0("Prediction scores - ", app.env$metadataxfer)
        metadata.cont <- c(
          list("Max prediction scores" = max.predictions),
          prediction.score.names,
          list("Other Metadata" = metadata.cont)
        )
        app.env$metadata.cont <- metadata.cont
        updateSelectizeInput(
          session = session,
          inputId = 'metadata.cont',
          choices = app.env$metadata.cont,
          selected = '',
          server = TRUE,
          options = selectize.opts
        )
        updateSelectizeInput(
          session = session,
          inputId = 'metadata.cont.motif',
          choices = app.env$metadata.cont,
          selected = '',
          server = TRUE,
          options = selectize.opts
        )
        updateSelectizeInput(
          session = session,
          inputId = 'metacolor.ref',
          choices = c(grep(pattern = '^predicted.', x = app.env$metadataxfer, value = TRUE), # re-ordering not working...
                      grep(pattern = '^predicted.', x = app.env$metadataxfer, value = TRUE, invert = TRUE)),
          selected = app.env$default.metadata,
          server = TRUE,
          options = selectize.opts[-which(x = names(x = selectize.opts) == 'maxItems')]
        )
        react.env$features <- TRUE
        if (isTRUE(x = do.bridge)) {
          react.env$motif.features <- TRUE
        } 
        react.env$metadata <- FALSE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$features,
    handlerExpr = {
      if (isTRUE(x = react.env$features)) {
        DefaultAssay(app.env$object) <- "RNA"
        app.env$default.feature <- ifelse(
          test = getOption(x = 'Azimuth.app.default_gene') %in% rownames(x = app.env$object),
          yes = getOption(x = 'Azimuth.app.default_gene'),
          no = VariableFeatures(object = app.env$object)[1]
        )
        app.env$features <- unique(x = c(
          FilterFeatures(
            features = VariableFeatures(object = app.env$object)[1:selectize.opts$maxOptions]
          ),
          FilterFeatures(features = rownames(x = app.env$object))
        ))
        updateSelectizeInput(
          session = session,
          inputId = 'feature',
          label = 'Feature',
          choices = app.env$features,
          selected = app.env$default.feature,
          server = TRUE,
          options = selectize.opts
        )
        if (isTRUE(x = do.adt)) {
          # app.env$adt.features <- sort(x = FilterFeatures(features = rownames(
          #   x = app.env$object[[adt.key]]
          # )))
          app.env$adt.features <- sort(x = rownames(
            x = app.env$object[[adt.key]]
          ))
          updateSelectizeInput(
            session = session,
            inputId = 'adtfeature',
            choices = app.env$adt.features,
            selected = '',
            server = TRUE,
            options = selectize.opts
          )
        }
        react.env$features <- FALSE
        if (!isTRUE(x = do.bridge)){
          react.env$markers <- TRUE
        }
      }
    }
  )
  observeEvent(
    eventExpr = react.env$motif.features, 
    handlerExpr = {
      if (isTRUE(x = react.env$motif.features)) {
        DefaultAssay(app.env$object) <- app.env$default.assay
        app.env$default.motif.feature <- ifelse(test = getOption(x = 'Azimuth.app.default_motif') %in% 
                                                  row.names(x = app.env$object[[app.env$default.assay]]@data), 
                                                yes = getOption(x = 'Azimuth.app.default_motif'), 
                                                no = row.names(x = app.env$object[[app.env$default.assay]]@data)[1])
        app.env$motif.features <- unique(x = row.names(x = app.env$object[[app.env$default.assay]]@data)) # c(FilterFeatures(features =
        updateSelectizeInput(session = session, inputId = "motif.feature", 
                             label = "Motif", choices = app.env$motif.features, 
                             selected = app.env$default.motif.feature, server = TRUE, 
                             options = selectize.opts)
        
        if (isTRUE(x = do.adt)) {
          app.env$adt.features <- sort(x = rownames(x = app.env$object[[adt.key]]))
          updateSelectizeInput(session = session, inputId = "adtfeature", 
                               choices = app.env$adt.features, selected = "", 
                               server = TRUE, options = selectize.opts)
        }
        react.env$motif.features <- FALSE
        react.env$markers <- TRUE
      }
    }
  )
  observeEvent(
    eventExpr = react.env$markers,
    handlerExpr = {
      if (isTRUE(x = react.env$markers)) {
        allowed.clusters <- names(x = which(
          x = table(app.env$object[[paste0("predicted.", app.env$default.metadata)]]) > getOption(x = 'Azimuth.de.mincells')
        ))
        allowed.clusters <- factor(
          x = allowed.clusters,
          levels = unique(x = app.env$object[[paste0("predicted.", app.env$default.metadata), drop = TRUE]])
        )
        allowed.clusters <- sort(x = levels(x = droplevels(x = na.omit(
          object = allowed.clusters
        ))))
        # updateSelectizeInput(
        #   session = session,
        #   inputId = 'select.prediction',
        #   choices = allowed.clusters,
        #   selected = allowed.clusters[1],
        #   server = TRUE,
        #   options = selectize.opts
        # )
        
        updateSelectizeInput(
          session = session,
          inputId = 'markerclusters',
          choices = allowed.clusters,
          selected = allowed.clusters[1],
          server = TRUE,
          options = selectize.opts
        )
        
        updateSelectizeInput(
          session = session,
          inputId = 'markerclustersgroup',
          choices = app.env$metadataxfer[!app.env$singlepred],
          selected = app.env$default.metadata,
          server = TRUE,
          options = selectize.opts
        )
        
        updateSelectizeInput(
          session = session,
          inputId = 'markerclustersgroup.motif',
          choices = app.env$metadataxfer[!app.env$singlepred],
          selected = app.env$default.metadata,
          server = TRUE,
          options = selectize.opts
        )
        
        react.env$markers <- FALSE
        app.env$disable <- FALSE
        react.env$get.feature <- TRUE
        if (isTRUE(x = do.bridge)){
          react.env$get.motif.feature <- TRUE
        }
      }
    }
  )
  observeEvent(
    eventExpr = react.env$no,
    handlerExpr = {
      if (FALSE) {
        # Enable the feature explorer
        
        # Add the predicted ID and score to the plots
        
        
        
        # Enable downloads
        
        
        react.env$no <- FALSE
      }
    }
  )
  # Handle input changes
  observeEvent( # RNA feature
    eventExpr = input$feature,
    handlerExpr = {
      if (nchar(x = input$feature)) {
        if (nchar(x = input$markerclustersgroup)) {
          if (isTRUE(x = do.bridge)) {
            app.env$feature <- ifelse(
              test = input$feature %in% rownames(x = app.env$object[[app.env$gene.assay]]),
              yes = paste0(
                Key(object = app.env$object[[app.env$gene.assay]]),
                input$feature
              ),
              no = input$feature
            )
          } else {
            app.env$feature <- ifelse(
              test = input$feature %in% rownames(x = app.env$object[["refAssay"]]),
              yes = paste0(
                Key(object = app.env$object[["refAssay"]]),
                input$feature
              ),
              no = input$feature
            )
          }
          for (f in c('adtfeature', 'metadata.cont')) {
            updateSelectizeInput(
              session = session,
              inputId = f,
              choices = list(
                'adtfeature' = app.env$adt.features,
                'metadata.cont' = app.env$metadata.cont
              )[[f]],
              selected = '',
              server = TRUE,
              options = selectize.opts
            )
          }
          table.check <- input$feature %in% rownames(x = RenderDiffExp(
            diff.exp = app.env$diff.expr[[paste(app.env$gene.assay, input$markerclustersgroup, sep = "_")]],
            groups.use = input$markerclusters,
            n = Inf
          ))
          tables.clear <- list(adt.proxy, rna.proxy)[c(TRUE, !table.check)]
          for (tab in tables.clear) {
            selectRows(proxy = tab, selected = NULL)
          }
        }
      }
    }
  )
  
  observeEvent( # motif feature
    eventExpr = input$motif.feature,
    handlerExpr = {
      if (nchar(x = input$motif.feature)) {
        if (nchar(x = input$markerclustersgroup.motif)) {
          app.env$motif.feature <- ifelse(
            test = input$motif.feature %in% rownames(x = app.env$object),
            yes = paste0(
              Key(object = app.env$object[[app.env$default.assay]]),
              input$motif.feature
            ),
            no = input$motif.feature
          )
          table.check <- input$motif.feature %in% rownames(x = RenderDiffMotifExp(
            diff.exp = app.env$motif.diff.expr[[paste(app.env$default.assay, input$markerclustersgroup.motif, sep = "_")]],
            groups.use = input$markerclusters.motif,
            n = Inf
          ))
          tables.clear <- list(adt.proxy, motif.proxy)[c(TRUE, !table.check)]
          for (tab in tables.clear) {
            selectRows(proxy = tab, selected = NULL)
          }
        }
      }
    }
  )
  
  observeEvent( # Protein feature
    eventExpr = input$adtfeature,
    handlerExpr = {
      if (nchar(x = input$adtfeature)) {
        app.env$feature <- paste0(
          Key(object = app.env$object[[adt.key]]),
          input$adtfeature
        )
        for (f in c('feature', 'metadata.cont')) {
          updateSelectizeInput(
            session = session,
            inputId = f,
            choices = list(
              'feature' = app.env$features,
              'metadata.cont' = app.env$metadata.cont
            )[[f]],
            selected = '',
            server = TRUE,
            options = selectize.opts
          )
        }
        table.check <- input$adtfeature %in% rownames(x = RenderDiffExp(
          diff.exp = app.env$diff.expr[[paste(adt.key, input$markerclustersgroup, sep = "_")]],
          groups.use = input$markerclusters,
          n = Inf
        ))
        tables.clear <- list(rna.proxy, adt.proxy)[c(TRUE, !table.check)]
        for (tab in tables.clear) {
          selectRows(proxy = tab, selected = NULL)
        }
      }
    }
  )
  observeEvent( # Continuous Metadata
    eventExpr = input$metadata.cont,
    handlerExpr = {
      if (nchar(x = input$metadata.cont)) {
        if (input$metadata.cont == "mapping.score") {
          if (resolved(x = app.env$mapping.score)) {
            app.env$object$mapping.score <- value(app.env$mapping.score)
          }
        }
        app.env$feature <- input$metadata.cont
        for (f in c('feature', 'adtfeature')) {
          updateSelectizeInput(
            session = session,
            inputId = f,
            choices = list(
              'feature' = app.env$features,
              'adtfeature' = app.env$adt.features
            )[[f]],
            selected = '',
            server = TRUE,
            options = selectize.opts
          )
        }
        for (tab in list(rna.proxy, adt.proxy)) {
          selectRows(proxy = tab, selected = NULL)
        }
      }
    }
  )
  observeEvent( # Continuous Metadata
    eventExpr = input$metadata.cont.motif,
    handlerExpr = {
      if (nchar(x = input$metadata.cont.motif)) {
        if (input$metadata.cont.motif == "mapping.score") {
          if (resolved(x = app.env$mapping.score)) {
            app.env$object$mapping.score <- value(app.env$mapping.score)
          }
        }
        app.env$feature <- input$metadata.cont.motif
        updateSelectizeInput(
          session = session,
          inputId = "motif.feature",
          choices = app.env$motiffeatures,
          selected = '',
          server = TRUE,
          options = selectize.opts
        )
        for (tab in list(rna.proxy, adt.proxy)) {
          selectRows(proxy = tab, selected = NULL)
        }
      }
    }
  )
  observeEvent( # Marker clusters group
    eventExpr = input$markerclustersgroup,
    handlerExpr = {
      if (nchar(x = input$markerclustersgroup)) {
        allowed.clusters <- names(x = which(
          x = table(app.env$object[[paste0("predicted.", input$markerclustersgroup)]]) > getOption(x = 'Azimuth.de.mincells')
        ))
        allowed.clusters <- factor(
          x = allowed.clusters,
          levels = unique(x = app.env$object[[paste0("predicted.", input$markerclustersgroup), drop = TRUE]])
        )
        allowed.clusters <- sort(x = levels(x = droplevels(x = na.omit(
          object = allowed.clusters
        ))))
        app.env$allowedclusters <- allowed.clusters
        updateSelectizeInput(
          session = session,
          inputId = "markerclusters",
          choices = app.env$allowedclusters,
          selected = app.env$allowedclusters[1],
          server = TRUE,
          options = selectize.opts
        )
      }
    }
  )
  observeEvent( # Marker clusters group motif
    eventExpr = input$markerclustersgroup.motif,
    handlerExpr = {
      if (nchar(x = input$markerclustersgroup.motif)) {
        allowed.clusters <- names(x = which(
          x = table(app.env$object[[paste0("predicted.", input$markerclustersgroup.motif)]]) > getOption(x = 'Azimuth.de.mincells')
        ))
        allowed.clusters <- factor(
          x = allowed.clusters,
          levels = unique(x = app.env$object[[paste0("predicted.", input$markerclustersgroup.motif), drop = TRUE]])
        )
        allowed.clusters <- sort(x = levels(x = droplevels(x = na.omit(
          object = allowed.clusters
        ))))
        app.env$allowedclusters <- allowed.clusters
        updateSelectizeInput(
          session = session,
          inputId = "markerclusters.motif",
          choices = app.env$allowedclusters,
          selected = app.env$allowedclusters[1],
          server = TRUE,
          options = selectize.opts
        )
      }
    }
  )
  observeEvent( # Select from biomarkers table
    eventExpr = input$biomarkers_rows_selected,
    handlerExpr = {
      if (length(x = input$biomarkers_rows_selected)) {
        updateSelectizeInput(
          session = session,
          inputId = 'feature',
          choices = app.env$features,
          selected = rownames(x = RenderDiffExp(
            diff.exp = app.env$diff.expr[[paste(app.env$gene.assay, input$markerclustersgroup, sep = "_")]],
            groups.use = input$markerclusters,
            n = Inf
          ))[input$biomarkers_rows_selected],
          server = TRUE,
          options = selectize.opts
        )
      }
    }
  )
  observeEvent( # Select from adtbio table
    eventExpr = input$adtbio_rows_selected,
    handlerExpr = {
      if (length(x = input$adtbio_rows_selected)) {
        updateSelectizeInput(
          session = session,
          inputId = 'adtfeature',
          choices = app.env$adt.features,
          selected = rownames(x = RenderDiffExp(
            diff.exp = app.env$diff.expr[[paste(adt.key, input$markerclustersgroup, sep = "_")]],
            groups.use = input$markerclusters,
            n = Inf
          ))[input$adtbio_rows_selected],
          server = TRUE,
          options = selectize.opts
        )
      }
    }
  )
  observeEvent( # Select from motif table
    eventExpr = input$motif_rows_selected,
    handlerExpr = {
      if (length(x = input$motif_rows_selected)) {
        updateSelectizeInput(
          session = session,
          inputId = 'motif',
          choices = app.env$motif.features,
          selected = rownames(x = RenderDiffMotifExp(
            diff.exp = app.env$motif.diff.expr[[paste(app.env$default.assay, input$markerclustersgroup.motif, sep = "_")]],
            groups.use = input$markerclusters.motif,
            n = Inf
          ))[input$motif_rows_selected],
          server = TRUE,
          options = selectize.opts
        )
      }
    }
  )
  observeEvent( # Once reference metadata is initialized, set the default legend/labels based on ref only
    eventExpr = input$metacolor.ref,
    handlerExpr = {
      if (length(x = unique(x = as.vector(x = refs$plot[[input$metacolor.ref[1], drop = TRUE]]))) >= 30) {
        if (isTRUE(app.env$fresh.plot)) {
          updateCheckboxInput(
            session = session,
            inputId = 'labels',
            value = TRUE
          )
          updateCheckboxInput(
            session = session,
            inputId = 'legend',
            value = FALSE
          )
          app.env$fresh.plot <- FALSE
        }
      }
    }
  )
  observeEvent( # Record feedback and update UI if feedback submitted
    eventExpr = input$submit_feedback,
    handlerExpr = {
      if (!is.null(x = googlesheet)) {
        try(expr = sheet_append(
          ss = googlesheet,
          data = data.frame(
            "FEEDBACK",
            app_session_id,
            paste0('feedback: \"', input$feedback, '\"')
          )
        ))
      }
      updateTextAreaInput(
        session = session,
        inputId = 'feedback',
        label = NULL,
        value = 'Thank you for your feedback!')
    }
  )
  observeEvent( # Change metadata appropriately
    eventExpr = input$showrefonly,
    handlerExpr = {
      if (!is.null(app.env$metadata.discrete)) {
        if (input$showrefonly) {
          # change to appropriate input$metacolor.ref if its an option
          disable(id = 'metacolor.query')
          enable(id = 'metacolor.ref')
        } else {
          # change to appropriate input$metacolor.query
          disable(id = 'metacolor.ref')
          enable(id = 'metacolor.query')
        }
      }
    }
  )
  # Plots
  output$plot.qc <- renderPlot(expr = {
    if (!is.null(x = isolate(expr = app.env$object)) & isTRUE(x = react.env$plot.qc)) {
      # all(paste0(c('nCount_', 'nFeature_'), app.env$default.assay) %in% colnames(app.env$object@meta.data)) ) {
      qc <- paste0(c('nCount_', 'nFeature_'), app.env$default.assay)
      if (isTRUE(x = react.env$mt)) {
        qc <- c(qc, mt.key)
      }
      check.qcpoints <- "qcpoints" %in% input$check.qc
      check.qcscale <- "qcscale" %in% input$check.qc
      vlnlist <- VlnPlot(
        object = isolate(app.env$object),
        features = qc,
        group.by = 'query',
        combine = FALSE,
        pt.size = ifelse(
          test = check.qcpoints,
          yes = 0,
          no = Seurat:::AutoPointSize(data = isolate(app.env$object))
        ),
        log = check.qcscale
      )
      # nCount
      vlnlist[[1]] <- vlnlist[[1]] +
        geom_hline(yintercept = input$num.ncountmin) +
        geom_hline(yintercept = input$num.ncountmax) +
        annotate(
          geom = "rect",
          alpha = 0.2,
          fill = "red",
          ymin = input$num.ncountmax,
          ymax = Inf,
          xmin = 0.5,
          xmax = 1.5
        ) +
        annotate(
          geom = "rect",
          alpha = 0.2,
          fill = "red",
          ymin = ifelse(test = check.qcscale, yes = 0, no = -Inf),
          ymax = input$num.ncountmin,
          xmin = 0.5,
          xmax = 1.5
        ) +
        NoLegend() +
        xlab("")
      # nFeature
      vlnlist[[2]] <- vlnlist[[2]] +
        geom_hline(yintercept = input$num.nfeaturemin) +
        geom_hline(yintercept = input$num.nfeaturemax) +
        annotate(
          geom = "rect",
          alpha = 0.2,
          fill = "red",
          ymin = input$num.nfeaturemax,
          ymax = Inf,
          xmin = 0.5,
          xmax = 1.5
        ) +
        annotate(
          geom = "rect",
          alpha = 0.2,
          fill = "red",
          ymin = ifelse(test = check.qcscale, yes = 0, no = -Inf),
          ymax = input$num.nfeaturemin,
          xmin = 0.5,
          xmax = 1.5
        ) +
        NoLegend() +
        xlab("")
      if (react.env$mt) {
        vlnlist[[3]] <- vlnlist[[3]] +
          geom_hline(yintercept = input$minmt) +
          geom_hline(yintercept = input$maxmt) +
          annotate(
            geom = "rect",
            alpha = 0.2,
            fill = "red",
            ymin = input$maxmt,
            ymax = Inf,
            xmin = 0.5,
            xmax = 1.5
          ) +
          annotate(
            geom = "rect",
            alpha = 0.2,
            fill = "red",
            ymin = ifelse(test = check.qcscale, yes = 0, no = -Inf),
            ymax = input$minmt,
            xmin = 0.5,
            xmax = 1.5
          ) +
          NoLegend() +
          xlab("")
      }
      wrap_plots(vlnlist, ncol = length(x = vlnlist))
    }
  })
  output$overlap_box <- renderUI(
    box(
      title = p(
        'Overlap QC',
        bsButton(
          inputId = 'q4',
          label = '',
          icon = icon(name = 'question'),
          style = 'info',
          size = 'extra-small'
        )
      ),
      bsPopover(
        id = 'q4',
        title = 'Overlap QC',
        content = paste(
          'The distribution of overlap percentages for each peak. A strongly left-skewed ',
          'distribution means that most of the peaks have ~100% overlap to the corresponding multiome peak', 
          'and thus the requantified peaks will (maintain) the data from the original peaks. Also, note the ', 
          'total overlap percentage for a summary of this information.'
        ),
        placement = 'right',
        trigger = 'focus',
        options = list(container = 'body')
      ),
      plotOutput(outputId = 'dist.qc'),
      width = 4
    )
  )
  output$dist.qc <- renderPlot(expr = {
    if (!is.null(x = isolate(expr = app.env$chromatin_assay_1)) & isTRUE(x = react.env$dist.qc)) {
      dist <- OverlapDistPlot(query_assay = isolate(app.env$chromatin_assay_1),
                              multiome = refs$map[["ATAC"]])
    }
  })
  output$refdim_intro <- renderPlot(expr = {
    # save plot dataframe to minimize on-hover computation
    app.env$plots.refdim_intro_df <- cbind(
      as.data.frame(x = Embeddings(object = refs$plot[['refUMAP']])),
      refs$plot[[]]
    )
    p <- DimPlot(
      object = refs$plot,
      combine = FALSE,
      group.by = default_xfer,
      cols = GetColorMap(object = refs$map)[[default_xfer]],
      repel = TRUE,
      label = TRUE,
      raster = FALSE
    )[[1]]
    # for later use by query plot:
    app.env$plot.ranges <- list(
      layer_scales(p)$x$range$range,
      layer_scales(p)$y$range$range
    )
    # strip down the intro plot-- no title, legend, or axes
    p + WelcomePlot()
  })
  output$refdim_intro_hover_box <- renderUI({
    hover <- input$refdim_intro_hover_location
    df <- app.env$plots.refdim_intro_df
    if (!is.null(x = hover)){
      hover[['mapping']] <- setNames(object = as.list(x = colnames(x = app.env$plots.refdim_intro_df)[1:2]), nm = c('x', 'y'))
    }
    point <- nearPoints(
      df = df,
      coordinfo = hover,
      threshold = 10,
      maxpoints = 1,
      addDist = TRUE
    )
    if (nrow(x = point) == 0) {
      return(NULL)
    }
    hovertext <- do.call(
      what = paste0,
      args = lapply(X = metadata.annotate, FUN = function(md) {
        paste0("<span>", md, "</span>: <i>", point[[md]], "</i><br>")
      })
    )
    wellPanel(
      style = HoverBoxStyle(x = hover$coords_css$x, y = hover$coords_css$y),
      p(HTML(text = hovertext))
    )
  })
  if (isTRUE(x = do.bridge)){
    output$all_qc <- renderUI(
      fluidRow(
        uiOutput(outputId = "overlap_box"),
        column(8, 
               fluidRow(
                 valueBoxOutput(outputId = 'valuebox.upload', width = 3),
                 div(
                   id = 'overlap_popup',
                   valueBoxOutput(outputId = "valuebox_overlap", width = 3),
                   bsTooltip(id = "valuebox_overlap", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
                 div(
                   id = 'jaccard_popup',
                   valueBoxOutput(outputId = "valuebox_jaccard", width = 3),
                   bsTooltip(id = "valuebox_jaccard", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
               ),
               fluidRow(
                 valueBoxOutput(outputId = 'valuebox.preproc', width = 3),
                 div(
                   id = 'panchors_popup',
                   valueBoxOutput(outputId = "valuebox_panchors", width = 3),
                   bsTooltip(id = "valuebox_panchors", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
                 div(
                   id = 'mappingqcstat_popup',
                   valueBoxOutput(outputId = "valuebox_mappingqcstat", width = 3),
                   bsTooltip(id = "valuebox_mappingqcstat", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
                 valueBoxOutput(outputId = 'valuebox.mapped', width = 3),
               )
        )
      )
    )
  } else {
    output$all_qc <- renderUI(
        fluidRow(
        column(8, 
               fluidRow(
                 valueBoxOutput(outputId = 'valuebox.upload', width = 3),
                 valueBoxOutput(outputId = 'valuebox.preproc', width = 3),
                 div(
                   id = 'panchors_popup',
                   valueBoxOutput(outputId = "valuebox_panchors", width = 3),
                   bsTooltip(id = "valuebox_panchors", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
                 div(
                   id = 'mappingqcstat_popup',
                   valueBoxOutput(outputId = "valuebox_mappingqcstat", width = 3),
                   bsTooltip(id = "valuebox_mappingqcstat", title = "Click for more info", placement = "top", trigger = 'hover'),
                 ),
                 valueBoxOutput(outputId = 'valuebox.mapped', width = 3),
               )
        )
      )
    )
    
  }
  output$refdim <- renderPlot(expr = {
    if (!is.null(x = input$metacolor.ref)) {
      colormaps <- GetColorMap(object = refs$map)[input$metacolor.ref]
      # no interactivity if multiple plots per row (less useful in this case)
      if (length(x = colormaps) == 1) {
        ## already stored reference dataframe in app.env
        app.env$plots.refdim_df <- app.env$plots.refdim_intro_df
        DimPlot(
          object = refs$plot,
          label = isTRUE("labels" %in% input$dimplot.opts),
          group.by = input$metacolor.ref,
          cols = colormaps[[1]],
          repel = TRUE,
          raster = FALSE
        )[[1]] +
          labs(x = "UMAP 1", y = "UMAP 2") +
          if (isFALSE(x = "legend" %in% input$dimplot.opts) | OversizedLegend(refs$plot[[input$metacolor.ref, drop = TRUE]])) NoLegend()
      } else {
        app.env$plots.refdim_df <- NULL
        plots <- list()
        for (i in 1:length(x = colormaps)) {
          plots[[i]] <- DimPlot(
            object = refs$plot,
            label = isTRUE("labels" %in% input$dimplot.opts),
            group.by = input$metacolor.ref[i],
            cols = colormaps[[i]],
            repel = TRUE,
            raster = FALSE
          ) + labs(x = "UMAP 1", y = "UMAP 2") +
            if (isFALSE(x = "legend" %in% input$dimplot.opts) | OversizedLegend(refs$plot[[input$metacolor.ref[i], drop = TRUE]])) NoLegend()
        }
        wrap_plots(plots, nrow = 1)
      }
    }
  })
  
  output$refdim_hover_box <- renderUI({
    if (!is.null(x = app.env$plots.refdim_df)) {
      hover <- input$refdim_hover_location
      df <- app.env$plots.refdim_df
      if (!is.null(x = hover)){
        hover[['mapping']] <- setNames(object = as.list(x = colnames(x = app.env$plots.refdim_intro_df)[1:2]), nm = c('x', 'y'))
      }
      point <- nearPoints(
        df = df,
        coordinfo = hover,
        threshold = 10,
        maxpoints = 1,
        addDist = TRUE
      )
      if (nrow(x = point) == 0) {
        return(NULL)
      }
      hovertext <- do.call(
        what = paste0,
        args = as.list(c(
          paste0("<b>", point[[input$metacolor.ref]], "</b><br>"),
          sapply(X = setdiff(possible.metadata.transfer, input$metacolor.ref), FUN = function(md) {
            paste0("<span>", md, "</span>: <i>", point[[md]], "</i><br>")
          })
        ))
      )
      wellPanel(
        style = HoverBoxStyle(x = hover$coords_css$x, y = hover$coords_css$y),
        p(HTML(text = hovertext))
      )
    }
  })
  
  output$objdim <- renderPlot(expr = {
    if (!is.null(x = app.env$object) && app.env$disable == FALSE) {
      # create empty ref
      if (is.null(x = app.env$emptyref) | is.null(x = app.env$merged)) {
        app.env$emptyref <- refs$plot
        Idents(object = app.env$emptyref) <- '.'
        for (md in colnames(x = app.env$emptyref[[]])) {
          app.env$emptyref[[md]] <- '.'
        }
        for (md in setdiff(
          x = colnames(x = app.env$object[[]]),
          y = colnames(x = app.env$emptyref[[]])
        )) {
          app.env$emptyref[[md]] <- '.'
        }
        app.env$object[['refUMAP']] <- app.env$object[['umap.proj']]
        app.env$merged <- merge(app.env$emptyref, app.env$object, merge.dr = 'refUMAP')
      }
      
      if (isFALSE(x = input$showrefonly) &
          length(x = Reductions(object = app.env$object)) &
          !is.null(x = input$metacolor.query)) { # SHOW OVERLAY
        app.env$plots.refdim_df <- NULL # hide reference hover box
        if (length(x = input$metacolor.query) == 1) {
          # get colormap if avail
          group.var <- gsub(pattern = "^predicted.", replacement = "", x = input$metacolor.query)
          colormap <- GetColorMap(object = refs$map)[[group.var]]
          if (!grepl(pattern = "^predicted.", x = input$metacolor.query)) {
            colormap <- CreateColorMap(ids=unique(as.vector(app.env$object[[input$metacolor.query,drop=T]])))
          }
          colormap['.'] <- '#F1F1F1'
          
          # make dataframe so don't need to recompute during hover- QUERY only!
          app.env$plots.objdim_df <- cbind(
            as.data.frame(x = Embeddings(object = app.env$object[['umap.proj']])),
            app.env$object[[]]
          )
          p <- DimPlot(
            object = app.env$merged,
            group.by = input$metacolor.query,
            label = FALSE,
            cols = colormap[names(x = colormap) %in% c(
              '.', unique(x = as.vector(x = app.env$object[[input$metacolor.query, drop = TRUE]])))],
            repel = TRUE,
            raster = FALSE,
            reduction = "refUMAP"
          )[[1]] +
            xlim(app.env$plot.ranges[[1]]) +
            ylim(app.env$plot.ranges[[2]]) +
            labs(x = "UMAP 1", y = "UMAP 2") +
            if (isFALSE(x = input$legend)) NoLegend()
          if (isTRUE(x = 'labels' %in% input$label.opts)) {
            keep <- if (isTRUE(x = 'filterlabels' %in% input$label.opts)) {
              t <- table(as.vector(x = app.env$object[[input$metacolor.query, drop = TRUE]]))
              names(x = t)[which(x = t > 0.02 * ncol(x = app.env$object))]
            } else NULL
            return(LabelClusters(
              plot = p,
              id = input$metacolor.query,
              clusters = keep
            ))
          }
          return(p)
        } else {
          app.env$plots.objdim_df <- NULL # no interactivity
          plots <- list()
          for (i in 1:length(x = input$metacolor.query)) {
            group.var <- gsub(pattern = "^predicted.", replacement = "", x = input$metacolor.query[i])
            colormap <- GetColorMap(object = refs$map)[[group.var]]
            if (!grepl(pattern = "^predicted.", x = input$metacolor.query[i])) {
              colormap <- CreateColorMap(
                ids = unique(x = as.vector(x = app.env$object[[input$metacolor.query[i], drop = TRUE]]))
              )
            }
            colormap['.'] <- '#F1F1F1'
            p <- DimPlot(
              object = app.env$merged,
              group.by = input$metacolor.query[i],
              cols = colormap[names(x = colormap) %in% c(
                '.', unique(x = as.vector(x = app.env$object[[input$metacolor.query[i], drop = TRUE]])))],
              repel = TRUE,
              raster = FALSE,
              reduction = "refUMAP"
            )[[1]] + xlim(app.env$plot.ranges[[1]]) +
              ylim(app.env$plot.ranges[[2]]) +
              labs(x = "UMAP 1", y = "UMAP 2") +
              if (isFALSE(x = input$legend) | OversizedLegend(annotation.list = app.env$object[[input$metacolor.query[i], drop = TRUE]])) NoLegend()
            if (isTRUE('labels' %in% input$label.opts)) {
              keep <- if (isTRUE(x = 'filterlabels' %in% input$label.opts)) {
                t <- table(as.vector(x = app.env$object[[input$metacolor.query[i], drop = TRUE]]))
                print(names(x = t)[which(t > 0.02 * ncol(x = app.env$object))])
                names(x = t)[which(t > 0.02 * ncol(x = app.env$object))]
              } else NULL
              plots[[i]] <- LabelClusters(
                plot = p,
                id = input$metacolor.query[i],
                clusters = keep
              )
            } else {
              plots[[i]]<-p
            }
          }
          wrap_plots(plots, nrow = 1)
        }
      } else { # SHOW REFERENCE ONLY
        app.env$plots.objdim_df <- NULL # hide query hover box
        if (!is.null(x = input$metacolor.ref)) {
          colormaps <- GetColorMap(object = refs$map)[input$metacolor.ref]
          if (length(x = colormaps) == 1) {
            app.env$plots.refdim_df <- app.env$plots.refdim_intro_df
            DimPlot(
              object = refs$plot,
              label = isTRUE('labels' %in% input$label.opts),
              group.by = input$metacolor.ref,
              cols = colormaps[[1]],
              repel = TRUE,
              raster = FALSE
            )[[1]] +
              labs(x = "UMAP 1", y = "UMAP 2") +
              if (isFALSE(input$legend) | OversizedLegend(annotation.list = refs$plot[[input$metacolor.ref, drop = TRUE]])) NoLegend()
          } else {
            app.env$plots.refdim_df <- NULL
            plots <- list()
            for (i in 1:length(x = colormaps)) {
              plots[[i]] <- DimPlot(
                object = refs$plot,
                label = isTRUE('labels' %in% input$label.opts),
                group.by = input$metacolor.ref[i],
                cols = colormaps[[i]],
                repel = TRUE,
                raster = FALSE
              ) + labs(x = "UMAP 1", y = "UMAP 2") +
                if (isFALSE(x = input$legend) | OversizedLegend(annotation.list = refs$plot[[input$metacolor.ref[i], drop = TRUE]])) NoLegend()
            }
            wrap_plots(plots, nrow = 1)
          }
        }
      }
    }
  })
  output$querydim <- renderPlot(expr = {
    if (!is.null(x = app.env$object)) {
      if (length(x = Reductions(object = app.env$object)) & !is.null(x = input$metacolor.query)) {
        if (length(x = input$metacolor.query) == 1) {
          # get colormap if avail
          group.var <- gsub(pattern = "^predicted.", replacement = "", x = input$metacolor.query)
          colormap <- GetColorMap(object = refs$map)[[group.var]]
          if (!grepl(pattern = "^predicted.", x = input$metacolor.query)) {
            colormap <- NULL
          }
          # make dataframe so don't need to recompute during hover
          app.env$plots.querydim_df <- cbind(
            as.data.frame(x = Embeddings(object = app.env$object[['umap.proj']])),
            app.env$object[[]]
          )
          DimPlot(
            object = app.env$object,
            group.by = input$metacolor.query,
            label = isTRUE('labels' %in% input$dimplot.opts),
            cols = colormap[names(x = colormap) %in% unique(x = app.env$object[[input$metacolor.query, drop = TRUE]])],
            repel = TRUE,
            reduction = "umap.proj"
          )[[1]] +
            xlim(app.env$plot.ranges[[1]]) +
            ylim(app.env$plot.ranges[[2]]) +
            labs(x = "UMAP 1", y = "UMAP 2") +
            if (isFALSE(x = "legend" %in% input$dimplot.opts) | OversizedLegend(app.env$object[[input$metacolor.query, drop = TRUE]])) NoLegend()
        } else {
          app.env$plots.querydim_df <- NULL
          plots <- list()
          for (i in 1:length(x = input$metacolor.query)) {
            group.var <- gsub(pattern = "^predicted.", replacement = "", x = input$metacolor.query[i])
            colormap <- GetColorMap(object = refs$map)[[group.var]]
            if (!grepl(pattern = "^predicted.", x = input$metacolor.query[i])) {
              colormap <- NULL
            }
            plots[[i]] <- DimPlot(
              object = app.env$object,
              group.by = input$metacolor.query[i],
              label = isTRUE('labels' %in% input$dimplot.opts),
              cols = colormap[names(x = colormap) %in% unique(x = app.env$object[[input$metacolor.query[i], drop = TRUE]])],
              repel = TRUE,
              reduction = "umap.proj"
            ) + xlim(app.env$plot.ranges[[1]]) +
              ylim(app.env$plot.ranges[[2]]) +
              labs(x = "UMAP 1", y = "UMAP 2") +
              if (isFALSE(x = "legend" %in% input$dimplot.opts) | OversizedLegend(app.env$object[[input$metacolor.query[i], drop = TRUE]])) NoLegend()
          }
          wrap_plots(plots, nrow = 1)
        }
      }
    }
  })
  
  output$objdim_hover_box <- renderUI({
    if (!is.null(x = app.env$plots.objdim_df)) {
      hover <- input$objdim_hover_location
      df <- app.env$plots.objdim_df
      if (!is.null(x = hover)){
        hover[['mapping']] <- setNames(object = as.list(x = colnames(x = app.env$plots.objdim_df)[1:2]), nm = c('x', 'y'))
      }
      point <- nearPoints(
        df = df,
        coordinfo = hover,
        threshold = 10,
        maxpoints = 1,
        addDist = TRUE
      )
      if (nrow(x = point) == 0) {
        return(NULL)
      }
      hovertext <- do.call(
        what = paste0,
        args = as.list(c(
          paste0("<b>", point[[input$metacolor.query]], "</b><br>"),
          if (grepl(pattern = "^predicted.", x = input$metacolor.query)) {
            paste0(
              "<i>prediction score</i>: <span>",
              format(
                x = round(x = point[[paste0(input$metacolor.query,'.score')]], digits = 2),
                nsmall = 2
              ),
              "</span><br>"
            )
          }
        ))
      )
      wellPanel(
        style = HoverBoxStyle(x = hover$coords_css$x, y = hover$coords_css$y),
        p(HTML(text = hovertext))
      )
    } else if (!is.null(x = app.env$plots.refdim_df)) {
      hover <- input$objdim_hover_location
      df <- app.env$plots.refdim_df
      if (!is.null(x = hover)){
        hover[['mapping']] <- setNames(object = as.list(x = colnames(x = app.env$plots.refdim_intro_df)[1:2]), nm = c('x', 'y'))
      }
      point <- nearPoints(
        df = df,
        coordinfo = hover,
        threshold = 10,
        maxpoints = 1,
        addDist = TRUE
      )
      if (nrow(x = point) == 0) {
        return(NULL)
      }
      hovertext <- do.call(
        what = paste0,
        args = as.list(c(
          paste0("<b>", point[[input$metacolor.ref]], "</b><br>"),
          sapply(X = setdiff(metadata.annotate, input$metacolor.ref), FUN = function(md) {
            paste0("<span>", md, "</span>: <i>", point[[md]], "</i><br>")
          })
        ))
      )
      wellPanel(
        style = HoverBoxStyle(x = hover$coords_css$x, y = hover$coords_css$y),
        p(HTML(text = hovertext))
      )
    }
  })
  output$querydim_hover_box <- renderUI({
    if (!is.null(x = app.env$plots.querydim_df)) {
      hover <- input$querydim_hover_location
      df <- app.env$plots.querydim_df
      if (!is.null(x = hover)){
        hover[['mapping']] <- setNames(object = as.list(x = colnames(x = app.env$plots.querydim_df)[1:2]), nm = c('x', 'y'))
      }
      point <- nearPoints(
        df = df,
        coordinfo = hover,
        threshold = 10,
        maxpoints = 1,
        addDist = TRUE
      )
      if (nrow(x = point) == 0) {
        return(NULL)
      }
      hovertext <- do.call(
        what = paste0,
        args = as.list(c(
          paste0("<b>", point[[input$metacolor.query]], "</b><br>"),
          if (grepl(pattern = "^predicted.", x = input$metacolor.query)) {
            paste0(
              "<i>prediction score</i>: <span>",
              format(
                x = round(x = point[[paste0(input$metacolor.query,'.score')]], digits = 2),
                nsmall = 2
              ),
              "</span><br>"
            )
          }
        ))
      )
      wellPanel(
        style = HoverBoxStyle(x = hover$coords_css$x, y = hover$coords_css$y),
        p(HTML(text = hovertext))
      )
    }
  })
  output$evln <- renderPlot(expr = {
    if (!is.null(x = app.env$object)) {
      if (isTRUE(x = do.bridge)){
        avail <- c(
          paste0(
            Key(object = app.env$object[[app.env$gene.assay]]),
            rownames(x = app.env$object[[app.env$gene.assay]])
          ),
          colnames(x = app.env$object[[]])
        )
      } else {
        DefaultAssay(app.env$object) <- "refAssay"
        avail <- c(
          paste0(
            Key(object = app.env$object[["refAssay"]]),
            rownames(x = app.env$object)
          ),
          colnames(x = app.env$object[[]])
        )
      }
      # prediction assays
      prediction.names <- unlist(x = lapply(
        X = app.env$metadataxfer,
        FUN = function(x) {
          assay <- paste0("prediction.score.", x)
          pred <- rep(x = x, times = nrow(x = app.env$object[[assay]]))
          names(x = pred) <- paste0(
            Key(object = app.env$object[[assay]]),
            rownames(x = app.env$object[[assay]])
          )
          return(pred)
        })
      )
      max.pred.names <- paste0("predicted.", app.env$metadataxfer, ".score")
      avail <- c(avail, names(x = prediction.names))
      if (do.adt) {
        avail <- c(
          avail,
          paste0(
            Key(object = app.env$object[[adt.key]]),
            rownames(x = app.env$object[[adt.key]])
          )
        )
      }
      
      if (app.env$feature %in% avail) {
        if (app.env$feature == "mapping.score" && !resolved(x = app.env$mapping.score)) {
          ggplot() +
            annotate("text", x = 4, y = 25, size=8, label = "Mapping score still computing ... ") +
            theme_void()
        } else {
          title <- if (isTRUE(x = do.bridge)){
            ifelse(
              test = grepl(pattern = '^rna_', x = app.env$feature),
              yes = gsub(pattern = '^rna_', replacement = '', x = app.env$feature),
              no = app.env$feature
            )
          } else {
            ifelse(
            test = grepl(pattern = '^refassay_', x = app.env$feature),
            yes = gsub(pattern = '^refassay_', replacement = '', x = app.env$feature),
            no = app.env$feature
          )
          }
          if (app.env$feature %in% names(x = prediction.names)) {
            pred <- strsplit(x = app.env$feature, split = "_")[[1]][2]
            group <- prediction.names[app.env$feature]
            title <- paste0("Prediction Score (", group, ") ", pred)
          }
          if (app.env$feature %in% max.pred.names) {
            pred <- gsub(pattern = "predicted.", replacement = "", x = app.env$feature)
            pred <- gsub(pattern = ".score", replacement = "", x = pred)
            title <- paste0("Max Prediction Score - ", pred)
          }
          VlnPlot(
            object = app.env$object,
            features = app.env$feature,
            group.by = input$metagroup,
            pt.size = ifelse(
              test = input$check.featpoints,
              yes = 0,
              no = Seurat:::AutoPointSize(data = app.env$object)
            )
          ) +
            ggtitle(label = title) +
            NoLegend()
        }
      }
    }
  })
  output$edim <- renderPlot(expr = {
    if (!is.null(x = app.env$object)) {
      palettes <- list(
        c("lightgrey", "blue"),
        c('lightgrey', 'darkred')
      )
      if (isTRUE(x = do.bridge)){
        names(x = palettes) <- c(
          Key(object = app.env$object[[app.env$gene.assay]]),
          'md_'
        )
      } else{
        DefaultAssay(app.env$object) <- "refAssay"
        names(x = palettes) <- c(
          Key(object = app.env$object[["refAssay"]]),
          'md_'
        )
      }
      if (do.adt) {
        palettes[[Key(object = app.env$object[[adt.key]])]] <-  c('lightgrey', 'darkgreen')
      }
      # prediction assays
      prediction.names <- unlist(x = lapply(
        X = app.env$metadataxfer,
        FUN = function(x) {
          assay <- paste0("prediction.score.", x)
          pred <- rep(x = x, times = nrow(x = app.env$object[[assay]]))
          names(x = pred) <- paste0(
            Key(object = app.env$object[[assay]]),
            rownames(x = app.env$object[[assay]])
          )
          return(pred)
        })
      )
      max.pred.names <- paste0("predicted.", app.env$metadataxfer, ".score")
      md <- c(colnames(x = app.env$object[[]]), names(x = prediction.names))
      feature.key <- if (app.env$feature %in% md) {
        'md_'
      } else {
        paste0(
          unlist(x = strsplit(x = app.env$feature, split = '_'))[1],
          '_'
        )
      }
      pal.use <- palettes[[feature.key]]
      if (!is.null(x = pal.use)) {
        if (app.env$feature == "mapping.score" && !resolved(x = app.env$mapping.score)) {
          ggplot() +
            annotate("text", x = 4, y = 25, size=8, label = "Mapping score still computing ... ") +
            theme_void()
        } else {
          title <- if (isTRUE(x = do.bridge)){
            ifelse(
              test = grepl(pattern = '^rna_', x = app.env$feature),
              yes = gsub(pattern = '^rna_', replacement = '', x = app.env$feature),
              no = app.env$feature
            )
          } else {
            ifelse(
              test = grepl(pattern = '^refassay_', x = app.env$feature),
              yes = gsub(pattern = '^refassay_', replacement = '', x = app.env$feature),
              no = app.env$feature
            )
          }
          if (app.env$feature %in% names(x = prediction.names)) {
            pred <- strsplit(x = app.env$feature, split = "_")[[1]][2]
            group <- prediction.names[app.env$feature]
            title <- paste0("Prediction Score (", group, ") ", pred)
          }
          if (app.env$feature %in% max.pred.names) {
            pred <- gsub(pattern = "predicted.", replacement = "", x = app.env$feature)
            pred <- gsub(pattern = ".score", replacement = "", x = pred)
            title <- paste0("Max Prediction Score - ", pred)
          }
          suppressWarnings(expr = FeaturePlot(
            object = app.env$object,
            features = app.env$feature,
            cols = pal.use,
            reduction = "umap.proj"
          )) + xlim(app.env$plot.ranges[[1]]) +
            ylim(app.env$plot.ranges[[2]]) +
            ggtitle(label = title)
        }
      }
    }
  })
  
  
  output$motifdim <- renderPlot(expr = {
    if (!is.null(x = app.env$object)) {
      palettes <- list(c("lightgrey", "blue"), c("lightgrey", 
                                                 "darkred"))
      names(x = palettes) <- c(Key(object = app.env$object[[app.env$default.assay]]), 
                               "md_")
      prediction.names <- unlist(x = lapply(X = app.env$metadataxfer, 
                                            FUN = function(x) {
                                              assay <- paste0("prediction.score.", x)
                                              pred <- rep(x = x, times = nrow(x = app.env$object[[assay]]))
                                              names(x = pred) <- paste0(Key(object = app.env$object[[assay]]), 
                                                                        rownames(x = app.env$object[[assay]]))
                                              return(pred)
                                            }))
      max.pred.names <- paste0("predicted.", app.env$metadataxfer, 
                               ".score")
      md <- c(colnames(x = app.env$object[[]]), names(x = prediction.names))
      feature.key <- if (app.env$motif.feature %in% md) {
        "md_"
      }
      else {
        paste0(unlist(x = strsplit(x = app.env$motif.feature, 
                                   split = "_"))[1], "_")
      }

      pal.use <- palettes[[feature.key]]
      if (!is.null(x = pal.use)) {
        if (app.env$motif.feature == "mapping.score" && !resolved(x = app.env$mapping.score)) {
          ggplot() + annotate("text", x = 4, y = 25, 
                              size = 8, label = "Mapping score still computing ... ") + 
            theme_void()
        }
        else {
          title <- ifelse(test = grepl(pattern = "^motif_", 
                                       x = app.env$feature), yes = gsub(pattern = "^motif_", 
                                                                        replacement = "", x = app.env$motif.feature), no = app.env$motif.feature)
          if (app.env$motif.feature %in% names(x = prediction.names)) {
            pred <- strsplit(x = app.env$motif.feature, split = "_")[[1]][2]
            group <- prediction.names[app.env$motif.feature]
            title <- paste0("Prediction Score (", group, 
                            ") ", pred)
          }
          if (app.env$motif.feature %in% max.pred.names) {
            pred <- gsub(pattern = "predicted.", replacement = "", 
                         x = app.env$motif.feature)
            pred <- gsub(pattern = ".score", replacement = "", 
                         x = pred)
            title <- paste0("Max Prediction Score - ", 
                            pred)
          }
          suppressWarnings(expr = FeaturePlot(object = app.env$object, 
                                              features = app.env$motif.feature, cols = pal.use, 
                                              min.cutoff = 'q10', max.cutoff = 'q90',  
                                              reduction = "umap.proj")) + xlim(app.env$plot.ranges[[1]]) + 
            ylim(app.env$plot.ranges[[2]]) + ggtitle(label = title)
        }
      }
    }
  })
  # Messages
  output$message <- renderUI(expr = {
    p(HTML(text = paste(app.env$messages, collapse = "<br />")))
  })
  output$containerid <- renderUI(expr = {
    p(HTML(text = paste(
      paste("debug ID:", Sys.info()[["nodename"]]),
      paste('Azimuth version:', packageVersion(pkg = 'Azimuth')),
      paste('Seurat version:', packageVersion(pkg = 'Seurat')),
      paste('Reference version:', ReferenceVersion(object = refs$map)),
      sep = "<br />"
    )))
  })
  output$text.cellsremain <- renderText(expr = {
    if (!is.null(x = isolate(app.env$object))) {
      ncount <- paste0('nCount_', DefaultAssay(object = isolate(app.env$object)))
      nfeature <- paste0('nFeature_', DefaultAssay(object = isolate(app.env$object)))
      cells.use <- isolate(app.env$object)[[ncount, drop = TRUE]] >= input$num.ncountmin &
        isolate(app.env$object)[[ncount, drop = TRUE]] <= input$num.ncountmax &
        isolate(app.env$object)[[nfeature, drop = TRUE]] >= input$num.nfeaturemin &
        isolate(app.env$object)[[nfeature, drop = TRUE]] <= input$num.nfeaturemax
      if (any(grepl(pattern = mito.pattern, x = rownames(x = isolate(app.env$object))))) {
        cells.use <- cells.use &
          isolate(app.env$object)[[mt.key, drop = TRUE]] >= input$minmt &
          isolate(app.env$object)[[mt.key, drop = TRUE]] <= input$maxmt
      }
      paste(sum(cells.use), "cells remain after current filters")
    }
  })
  output$text.dladt <- renderText(
    expr = {
      c(
        "imputed.assay <- readRDS('azimuth_impADT.Rds')",
        "object <- object[, Cells(imputed.assay)]",
        "object[['impADT']] <- imputed.assay"
      )
    },
    sep = "\n"
  )
  output$text.dlumap <- renderText(
    expr = {
      c(
        "projected.umap <- readRDS('azimuth_umap.Rds')",
        "object <- object[, Cells(projected.umap)]",
        "object[['umap.proj']] <- projected.umap"
      )
    },
    sep = "\n"
  )
  output$text.dlpred <- renderText(
    expr = {
      c(
        "predictions <- read.delim('azimuth_pred.tsv', row.names = 1)",
        "object <- AddMetaData(",
        "\tobject = object,",
        "\tmetadata = predictions)"
      )
    },
    sep = "\n"
  )
  output$text.dlall <- renderText(
    expr = {
      c(
        "object <- AddAzimuthResults(object, filename = 'azimuth_results.Rds')"
      )
    },
    sep = "\n"
  )
  # Tables
  output$table.qc <- renderTable(
    expr = {
      if (!is.null(x = isolate(app.env$object))) {
        qc <- paste0(c('nCount_', 'nFeature_'), app.env$default.assay)
        tbl <- apply(X = isolate(app.env$object)[[qc]], MARGIN = 2, FUN = quantile)
        tbl <- as.data.frame(x = tbl)
        if (isTRUE(x = do.bridge)){
          colnames(x = tbl) <- c('Fragments per cell', 'Peaks detected per cell')
        } else{
          colnames(x = tbl) <- c('nUMI per cell', 'Genes detected per cell')
        }
        if (mt.key %in% colnames(x = isolate(app.env$object)[[]])) {
          tbl[, 3] <- quantile(x = isolate(app.env$object)[[mt.key, drop = TRUE]])
          colnames(x = tbl)[3] <- 'Mitochondrial percentage per cell'
        }
        t(x = tbl)
      }
    },
    rownames = TRUE
  )
  output$biomarkers <- renderDT(
    expr = {
      if (!is.null(x = app.env$diff.expr[[paste(app.env$gene.assay, input$markerclustersgroup, sep ="_")]])) {
        RenderDiffExp(
          diff.exp =  app.env$diff.expr[[paste(app.env$gene.assay, input$markerclustersgroup, sep ="_")]],
          groups.use = input$markerclusters,
          n = Inf
        )
      }
    },
    selection = 'single',
    options = list(dom = 't')
  )
  output$adtbio <- renderDT(
    expr = {
      if (!is.null(x = app.env$diff.expr[[paste(adt.key, input$markerclustersgroup, sep = "_")]])) {
        RenderDiffExp(
          diff.exp = app.env$diff.expr[[paste(adt.key, input$markerclustersgroup, sep = "_")]],
          groups.use = input$markerclusters,
          n = Inf
        )
      }
    },
    selection = 'single',
    options = list(dom = 't')
  )
  output$motifs <- renderDT(
    expr = {
      if (!is.null(x = app.env$motif.diff.expr[[paste(app.env$default.assay, input$markerclustersgroup.motif, sep ="_")]])) {
        RenderDiffMotifExp(
          diff.exp =  app.env$motif.diff.expr[[paste(app.env$default.assay, input$markerclustersgroup.motif, sep ="_")]],
          groups.use = input$markerclusters.motif,
          n = Inf
        )
      }
    },
    selection = 'single',
    options = list(dom = 't')
  )
  output$metadata.table <- renderTable(
    expr = {
      if (!is.null(x = app.env$object)) {
        CategoryTable(
          object = app.env$object,
          category.1 = input$metarow,
          category.2 = input$metacol,
          percentage = (input$radio.pct == "Percentage")
        )
      }
    },
    rownames = TRUE
  )
  output$metadata.heatmap <- renderPlotly({
    table <- CategoryTable(
      object = app.env$object,
      category.1 = input$metarow,
      category.2 = input$metacol,
      percentage = (input$radio.pct == "Percentage")
    )
    table <- as.matrix(table)
    plot_ly(x = colnames(table), y = rownames(table), z = table, type = 'heatmap',
            height='1000px')
  })
  # Downloads
  output$dlumap <- downloadHandler(
    filename = paste0(tolower(x = app.title), '_umap.Rds'),
    content = function(file) {
      if (!is.null(x = app.env$object)) {
        if ('umap.proj' %in% Reductions(object = app.env$object)) {
          saveRDS(object = app.env$object[['umap.proj']], file = file)
        }
      }
    }
  )
  output$dladt <- downloadHandler(
    filename = paste0(tolower(x = app.title), '_impADT.Rds'),
    content = function(file) {
      if (!is.null(x = app.env$object)) {
        if ('impADT' %in% Assays(object = app.env$object)) {
          saveRDS(object = app.env$object[['impADT']], file = file)
        }
      }
    }
  )
  output$dlpred <- downloadHandler(
    filename = paste0(tolower(x = app.title), '_pred.tsv'),
    content = function(file) {
      req <- paste0("predicted.", c(app.env$metadataxfer, paste0(app.env$metadataxfer, ".score")))
      if (resolved(x = app.env$mapping.score)) {
        req <- c(req, 'mapping.score')
      }
      if (all(req %in% colnames(x = app.env$object[[]]))) {
        pred.df <- app.env$object[[req]]
        if (resolved(x = app.env$mapping.score)) {
          pred.df$mapping.score <- value(app.env$mapping.score)
        }
        pred.df <- cbind(cell = rownames(x = pred.df), pred.df)
        write.table(
          x = pred.df,
          file = file,
          quote = FALSE,
          row.names = FALSE,
          col.names = TRUE,
          sep = '\t'
        )
      }
    }
  )
  output$dlall <- downloadHandler(
    filename = paste0(tolower(x = app.title), '_results.Rds'),
    content = function(file) {
      results <- list()
      if (!is.null(x = app.env$object)) {
        if ('impADT' %in% Assays(object = app.env$object)) {
          results$impADT <- app.env$object[['impADT']]
        }
        if ('umap.proj' %in% Reductions(object = app.env$object)) {
          results$umap <- app.env$object[['umap.proj']]
        }
      }
      
      req <- paste0("predicted.", c(app.env$metadataxfer, paste0(app.env$metadataxfer, ".score")))
      if (resolved(x = app.env$mapping.score)) {
        req <- c(req, 'mapping.score')
      }
      if (all(req %in% colnames(x = app.env$object[[]]))) {
        pred.df <- app.env$object[[req]]
        if (resolved(x = app.env$mapping.score)) {
          pred.df$mapping.score <- value(app.env$mapping.score)
        }
        pred.df <- cbind(cell = rownames(x = pred.df), pred.df)
        results$pred.df <- pred.df
      }
      
      saveRDS(results, file = file)
    }
  )
  output$dlscript <- downloadHandler(
    filename = paste0(tolower(x = app.title), '_analysis.R'),
    content = function(file) {
      template <- readLines(con = system.file(
        file.path('resources', 'template.R'),
        package = 'Azimuth'
      ))
      template <- paste(template, collapse = '\n')
      e <- new.env()
      # e$ref.uri <- 'https://seurat.nygenome.org/references/pbmc/'
      e$ref.uri <- getOption(
        x = 'Azimuth.app.refuri',
        default = getOption(x = 'Azimuth.app.reference')
      )
      e$path <- input$file$name
      e$mito.pattern <- getOption(x = 'Azimuth.app.mito', default = '^MT-')
      e$mito.key <- mt.key
      e$ncount.max <- input$num.ncountmax
      e$ncount.min <- input$num.ncountmin
      e$nfeature.max <- input$num.nfeaturemax
      e$nfeature.min <- input$num.nfeaturemin
      e$mito.max <- input$maxmt
      e$mito.min <- input$minmt
      e$sct.ncells <- getOption(x = 'Azimuth.sct.ncells')
      e$sct.nfeats <- getOption(x = 'Azimuth.sct.nfeats')
      e$ntrees <- getOption(x = 'Azimuth.map.ntrees')
      e$ndims <- getOption(x = "Azimuth.map.ndims")
      e$adt.key <- adt.key
      e$do.adt <- do.adt
      e$metadataxfer <- app.env$metadataxfer
      if (length(x = e$metadataxfer == 1)) {
        e$metadataxfer <- paste0("\"", e$metadataxfer, "\"")
      }
      e$plotgene <- getOption(x = 'Azimuth.app.default_gene')
      e$plotadt <- getOption(x = 'Azimuth.app.default_adt')
      writeLines(text = str_interp(string = template, env = e), con = file)
    }
  )
  # render UI elements that depend on arguments
  output$refdescriptor <- renderText(
    expr = eval(expr = HTML(getOption(x = "Azimuth.app.refdescriptor")))
  )
  output$welcomebox <- renderUI(
    expr = eval(expr = parse(text = getOption(x = "Azimuth.app.welcomebox")))
  )
  
  # render popup UI elements
  onclick('upload_popup', showModal(modalDialog(
    title = "Upload QC",
    div(
      paste(
        "The Azimuth reference-mapping procedure first identifies a set of 'anchors', ",
        "or pairwise correspondences between cells predicted to be in a similar biological state, ",
        "between query and reference datasets. Here we report the percentage of query cells ",
        "participating in an anchor correspondence. The box color corresponds to the following bins: "
      ),
      tags$ul(list(
        tags$li(paste0("0% to ", getOption(x = "Azimuth.map.panchorscolors")[1], "%: Likely problematic (red)")),
        tags$li(paste0(getOption(x = "Azimuth.map.panchorscolors")[1], "% to ", getOption(x = "Azimuth.map.panchorscolors")[2], "%: Possibly problematic (yellow)")),
        tags$li(paste0(getOption(x = "Azimuth.map.panchorscolors")[2], "% to 100%: Likely successful (green)"))
      )),
      tags$h4("Caveats"),
      paste0(
        "If the query dataset consists of a homogeneous group of cells, or if the ",
        "query dataset contains cells from multiple batches (which would be corrected ",
        "by Azimuth), this metric may return a low value even in cases where mapping is ",
        "successful. Users in these cases should check results carefully. In particular, ",
        "we encourage users to verify identified differentially expressed marker genes for annotated cell types."
      )
    )
  )))
  onclick('overlap_popup', showModal(modalDialog(
    title = "Overlap QC",
    div(
      paste(
        "In order to conduct bridge integration for ATAC data without uploading a large ",
        "fragment file, we requantify the ATAC query peaks to match the multiomic bridge ",
        "based on the overlap between each query peak to a bridge peak and rename the query ",
        "peak to the bridge peak with highest overlap. The box color corresponds to the following bins: "
      ),
      tags$ul(list(
        tags$li(paste0("0% to 60%: Likely problematic (red)")),
        tags$li(paste0("60% to 80%:  Possibly problematic (yellow)")),
        tags$li(paste0("80% to 100%: Likely successful (green)"))
      )),
      tags$h4("Caveats"),
      paste0(
        "A high percentage of overlap is expected if the query ATAC data and bridge ATAC data ",
        "were processed with the same versions of Cell Ranger and means that there will ",
        "likely be little loss of information by using this overlap renaming process. ",
        "The mapping can still be sucessesful if this value has a low percentage, but downstream motif",
        "calculations may be innacurate as this again uses another overlap process to requantify peaks to motifs."
      )
    )
  )))
  onclick('jaccard_popup', showModal(modalDialog(
    title = "Blank QC",
    div(
      paste(
        "In order to conduct bridge integration for ATAC data without uploading a large ", 
        "fragment file, we requantify the ATAC query peaks to match the multiomic bridge ", 
        "based on the overlap between each query peak to a bridge peak and rename the query ", 
        "peak to the bridge peak with highest overlap. The box color corresponds to the following bins: "
      ),
      tags$ul(list(
        tags$li(paste0("0% to 20%: Likely problematic (red)")),
        tags$li(paste0("20% to 50%:  Possibly problematic (yellow)")),
        tags$li(paste0("50% to 100%: Likely successful (green)"))
      )),
      tags$h4("Caveats"),
      paste0(
        "A high jaccard similarity is expected if most of the peaks in the ATAC query are represented in the ", 
        "multiome data. This is expected to be lower than the overlap percentage as the query may contain extraneous ", 
        "peaks not captured in the mutliome. If this is low, you can still get good mapping if overlap is high.",
        "Gene activity scores are calculated with the original peaks, however, motifs are calculated based ", 
        "on the requantified counts, so be sure to check if the motif results make sense if your jaccard similarity is low."
      )
    )
  )))
  onclick('panchors_popup', showModal(modalDialog(
    title = "Anchor QC",
    div(
      paste(
        "The Azimuth reference-mapping procedure first identifies a set of 'anchors', ",
        "or pairwise correspondences between cells predicted to be in a similar biological state, ",
        "between query and reference datasets. Here we report the percentage of query cells ",
        "participating in an anchor correspondence. The box color corresponds to the following bins: "
      ),
      tags$ul(list(
        tags$li(paste0("0% to ", getOption(x = "Azimuth.map.panchorscolors")[1], "%: Likely problematic (red)")),
        tags$li(paste0(getOption(x = "Azimuth.map.panchorscolors")[1], "% to ", getOption(x = "Azimuth.map.panchorscolors")[2], "%: Possibly problematic (yellow)")),
        tags$li(paste0(getOption(x = "Azimuth.map.panchorscolors")[2], "% to 100%: Likely successful (green)"))
      )),
      tags$h4("Caveats"),
      paste0(
        "If the query dataset consists of a homogeneous group of cells, or if the ",
        "query dataset contains cells from multiple batches (which would be corrected ",
        "by Azimuth), this metric may return a low value even in cases where mapping is ",
        "successful. Users in these cases should check results carefully. In particular, ",
        "we encourage users to verify identified differentially expressed marker genes for annotated cell types."
      )
    )
  )))
  onclick('mappingqcstat_popup', showModal(modalDialog(
    title = "Cluster Preservation",
    div(
      tags$h4("Overview"),
      paste0(
        "For each query dataset, we downsample to at most 5,000 cells, and perform an ",
        "unsupervised clustering. This score reflects the preservation of the unsupervised ",
        "cluster structure, and is based on the entropy of unsupervised cluster labels in ",
        "each query cell's local neighborhood after mapping. Scores are scaled from 0 (poor) to 5 (best)"
      ),
      tags$ul(list(
        tags$li(paste0("0 to ", getOption(x = "Azimuth.map.postmapqccolors")[1], ": Likely problematic (red)")),
        tags$li(paste0(getOption(x = "Azimuth.map.postmapqccolors")[1], " to ", getOption(x = "Azimuth.map.postmapqccolors")[2], ": Possibly problematic (yellow)")),
        tags$li(paste0(getOption(x = "Azimuth.map.postmapqccolors")[2], " to 5: Likely successful (green)"))
      )),
      tags$h4("Caveats"),
      paste0(
        "This metric relies on the unsupervised clustering representing corresponding to ",
        "biologically distinct cell states. If the query dataset consists of a homogeneous ",
        "group of cells, or if the query dataset contains cells from multiple batches ",
        "(which would be corrected by Azimuth), this metric may return a low value even ",
        "in cases where mapping is successful. Users in these cases should check results ",
        "carefully. In particular, we encourage users to verify identified differentially ",
        "expressed marker genes for annotated cell types."
      ),
      # tags$h4("Details"),
      # paste0(
      #   "To compute the mapping statistic, we first randomly downsample the ",
      #   "query to ", getOption(x = "Azimuth.map.postmapqcds"), " cells for ",
      #   "computational efficiency. We then compute an independent unsupervised ",
      #   "clustering on the query. Using these cluster IDs, we then examine the ",
      #   "neighborhoods of each cell in query PCA space and also in the mapped ",
      #   "(projected) space. We compute an entropy of cluster labels and then ",
      #   "take the mean entropy averaged over each cluster in both spaces. For ",
      #   "each cluster we take the difference and report a single statistic as ",
      #   "the median -log2 of these values, clipped to range between 0 and 5.",
      #   "For the exact implementation details, please see the ",
      #   "ClusterPreservationScore function in the azimuth github repo."
      # ),
      
    )
  )))
}

